An expanded name used within a generic package declaration must be handled specially because the prefix may denote a parent unit that will have a different name in an instance. We introduce a renaming of the generic unit and replace the expanded name with a reference to that renaming, The renaming declaaration must be intruduced after the leading pragmas in the current declarative part, which may be library unit pragmas. The pragma Compile_Time_Error is not in this category, and the renaming declaration must preceed it.
Compiling main.adb must yield: main.adb:4:04: instantiation error at parent-gen.ads:7 main.adb:4:04: Error --- with Parent.Gen; procedure Main is package G is new Parent.Gen; begin null; end Main; --- package Parent is pragma Pure; end Parent; --- generic package Parent.Gen is pragma Compile_Time_Error (not Parent.Gen'Library_Level, "Error"); end Parent.Gen; Tested on x86_64-pc-linux-gnu, committed on trunk 2017-11-09 Ed Schonberg <schonb...@adacore.com> * sem_ch12.adb (Analyze_Generic_Package_Declaration): Handle properly the pragma Compile_Time_Error when it appears in a generic package declaration and uses an expanded name to denote the current unit.
Index: sem_ch12.adb =================================================================== --- sem_ch12.adb (revision 254579) +++ sem_ch12.adb (revision 254580) @@ -3466,9 +3466,9 @@ ------------------------------------------ procedure Analyze_Generic_Package_Declaration (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - Decls : constant List_Id := - Visible_Declarations (Specification (N)); + Decls : constant List_Id := Visible_Declarations (Specification (N)); + Loc : constant Source_Ptr := Sloc (N); + Decl : Node_Id; Id : Entity_Id; New_N : Node_Id; @@ -3492,9 +3492,20 @@ Name => Make_Identifier (Loc, Chars (Defining_Entity (N)))); + -- The declaration is inserted before other declarations, but before + -- pragmas that may be library-unit pragmas and must appear before other + -- declarations. The pragma Compile_Time_Error is not in this class, and + -- may contain an expression that includes such a qualified name, so the + -- renaming declaration must appear before it. + + -- Are there other pragmas that require this special handling ??? + if Present (Decls) then Decl := First (Decls); - while Present (Decl) and then Nkind (Decl) = N_Pragma loop + while Present (Decl) + and then Nkind (Decl) = N_Pragma + and then Get_Pragma_Id (Decl) /= Pragma_Compile_Time_Error + loop Next (Decl); end loop;