This patch adds a missing legality check on the instantiation of a formal derived type whose parent type is a previous formal of the same generic unit, that is not a derived type.
Compiling generic_testm.adb must yield: generic_testm.adb:7:26: expect type derived from "Integer" in instantiation generic_testm.adb:7:26: instantiation abandoned generic_testm.adb:20:26: expect type derived from "Boolean" in instantiation generic_testm.adb:20:26: instantiation abandoned generic_testm.adb:26:10: "Convert" is undefined (more references follow) generic_testm.adb:32:15: "Convert_Pfff" is undefined --- with Generic_Test; procedure Generic_TestM is package Convert is new Generic_Test (Data_Type => Natural, Other_Data_Type => Boolean); From : constant Natural := Natural'First; To : Boolean; type Pfff is record Pff_1 : Natural; Pff_2 : Character; end record; package Convert_Pfff is new Generic_Test (Data_Type => Boolean, Other_Data_Type => Pfff); To_Pfff : Pfff; From_Pfff : constant Boolean := Boolean'First; begin To := Convert.Data_To_Other (Data => From); if To /= Convert.Data_To_Other (Data => 0) then raise Constraint_Error; end if; To_Pfff := Convert_Pfff.Data_To_Other (Data => From_Pfff); if not To_Pfff.Pff_1'Valid or not To_Pfff.Pff_2'Valid then raise Constraint_Error; end if; end; --- generic type Data_Type is (<>); type Other_Data_Type is new Data_Type; package Generic_Test is -- Add the parameter with provided Id and its value -- to the list of parameters. function Data_To_Other (Data : in Data_Type) return Other_Data_Type; end Generic_Test; -- package body Generic_Test is function Data_To_Other (Data : in Data_Type) return Other_Data_Type is begin return Other_Data_Type (Data); end Data_To_Other; end Generic_Test; Tested on x86_64-pc-linux-gnu, committed on trunk 2015-05-12 Ed Schonberg <schonb...@adacore.com> * sem_ch12.adb (Validate_Derived_Type_Instance): Handle properly the checks on a derived formal whose parent type is a previous formal that is not a derived type.
Index: sem_ch12.adb =================================================================== --- sem_ch12.adb (revision 223064) +++ sem_ch12.adb (working copy) @@ -11698,6 +11698,14 @@ Get_Instance_Of (Base_Type (Get_Instance_Of (A_Gen_T))); end if; + -- Check whether parent is a previous formal of the current generic + + elsif Is_Derived_Type (A_Gen_T) + and then Is_Generic_Type (Etype (A_Gen_T)) + and then Scope (A_Gen_T) = Scope (Etype (A_Gen_T)) + then + Ancestor := Get_Instance_Of (First_Subtype (Etype (A_Gen_T))); + -- An unusual case: the actual is a type declared in a parent unit, -- but is not a formal type so there is no instance_of for it. -- Retrieve it by analyzing the record extension. @@ -11733,6 +11741,9 @@ Actual, Ancestor); end if; + -- Finally verify that the (instance of) the ancestor is an ancestor + -- of the actual. + elsif not Is_Ancestor (Base_Type (Ancestor), Act_T) then Error_Msg_NE ("expect type derived from & in instantiation",