This patch implements properly the handling of categorization aspects that
apply to a package instantiation.
Compiling inst.ads must yield:
inst.ads:1:06: cannot depend on "Gen" (wrong categorization)
inst.ads:1:06: pure unit cannot depend on non-pure unit
generic
type T is private;
package Gen
with Preelaborate
is
end Gen;
---
with gen;
package Inst is new Gen (Integer)
with Pure;
Tested on x86_64-pc-linux-gnu, committed on trunk
2013-09-10 Ed Schonberg <schonb...@adacore.com>
* sem_ch12.adb (Analyze_Package_Instantiation): If the
instantiation is a compilation unit, analyze aspects before
analyzing the package declaration for the instance.
* sem_ch13.adb (Analyze_Aspect_Specifications): If the
corresponding node is a package instantiation, insert generated
pragmas at the head of visible declarations.
* sem_prag.adb (Analyze_Pragma, case Preelaborate): In an instance
do not ignore the pragma if it comes from an aspect specification
in the instance, and not from the generic unit.
* sprint.adb (Sprint_Node_Actual): For a package declaration that
is an instantiation, print aspects after declaration.
Index: sem_prag.adb
===================================================================
--- sem_prag.adb (revision 202452)
+++ sem_prag.adb (working copy)
@@ -15144,16 +15144,22 @@
Ent := Find_Lib_Unit_Name;
Check_Duplicate_Pragma (Ent);
- -- This filters out pragmas inside generic parent then
- -- show up inside instantiation
+ -- This filters out pragmas inside generic parents that show up
+ -- inside instantiations. Pragmas that come from aspects in the
+ -- unit are not ignored.
- if Present (Ent)
- and then not (Pk = N_Package_Specification
- and then Present (Generic_Parent (Pa)))
- then
- if not Debug_Flag_U then
- Set_Is_Preelaborated (Ent);
- Set_Suppress_Elaboration_Warnings (Ent);
+ if Present (Ent) then
+ if Pk = N_Package_Specification
+ and then Present (Generic_Parent (Pa))
+ and then not From_Aspect_Specification (N)
+ then
+ null;
+
+ else
+ if not Debug_Flag_U then
+ Set_Is_Preelaborated (Ent);
+ Set_Suppress_Elaboration_Warnings (Ent);
+ end if;
end if;
end if;
end Preelaborate;
Index: sem_ch12.adb
===================================================================
--- sem_ch12.adb (revision 202451)
+++ sem_ch12.adb (working copy)
@@ -3912,6 +3912,7 @@
if Nkind (Parent (N)) /= N_Compilation_Unit then
Mark_Rewrite_Insertion (Act_Decl);
Insert_Before (N, Act_Decl);
+
Analyze (Act_Decl);
-- For an instantiation that is a compilation unit, place
@@ -3940,6 +3941,15 @@
Set_Unit (Parent (N), Act_Decl);
Set_Parent_Spec (Act_Decl, Parent_Spec (N));
Set_Package_Instantiation (Act_Decl_Id, N);
+
+ -- Process aspect specifications of the instance node, if any, to
+ -- take into account categorization pragmas before analyzing the
+ -- instance.
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Act_Decl_Id);
+ end if;
+
Analyze (Act_Decl);
Set_Unit (Parent (N), N);
Set_Body_Required (Parent (N), False);
@@ -4043,7 +4053,7 @@
end if;
<<Leave>>
- if Has_Aspects (N) then
+ if Has_Aspects (N) and then Nkind (Parent (N)) /= N_Compilation_Unit then
Analyze_Aspect_Specifications (N, Act_Decl_Id);
end if;
Index: sprint.adb
===================================================================
--- sprint.adb (revision 202451)
+++ sprint.adb (working copy)
@@ -2479,6 +2479,18 @@
Sprint_Node_Sloc (Specification (Node));
Write_Char (';');
+ -- If this is an instantiation, get the aspects from the original
+ -- instantiation node.
+
+ if Is_Generic_Instance (Defining_Entity (Node))
+ and then Has_Aspects (
+ Package_Instantiation (Defining_Entity (Node)))
+ then
+ Sprint_Aspect_Specifications
+ (Package_Instantiation (Defining_Entity (Node)),
+ Semicolon => True);
+ end if;
+
when N_Package_Instantiation =>
Extra_Blank_Line;
Write_Indent_Str_Sloc ("package ");
@@ -2499,12 +2511,27 @@
Write_Str_With_Col_Check_Sloc ("package ");
Sprint_Node (Defining_Unit_Name (Node));
- if Nkind_In (Parent (Node), N_Package_Declaration,
- N_Generic_Package_Declaration)
+ if Nkind (Parent (Node)) = N_Generic_Package_Declaration
and then Has_Aspects (Parent (Node))
then
Sprint_Aspect_Specifications
(Parent (Node), Semicolon => False);
+
+ -- An instantiation is rewritten as a package declaration, but
+ -- the aspects belong to the instantiation node.
+
+ elsif Nkind (Parent (Node)) = N_Package_Declaration then
+ declare
+ Pack : constant Entity_Id := Defining_Entity (Node);
+
+ begin
+ if not Is_Generic_Instance (Pack) then
+ if Has_Aspects (Parent (Node)) then
+ Sprint_Aspect_Specifications
+ (Parent (Node), Semicolon => False);
+ end if;
+ end if;
+ end;
end if;
Write_Str (" is");
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 202451)
+++ sem_ch13.adb (working copy)
@@ -2112,7 +2112,8 @@
-- node (no delay is required here) except for aspects on a
-- subprogram body (see below) and a generic package, for which
-- we need to introduce the pragma before building the generic
- -- copy (see sem_ch12).
+ -- copy (see sem_ch12), and for package instantiations, where
+ -- the library unit pragmas are better handled early.
elsif Nkind (Parent (N)) = N_Compilation_Unit
and then (Present (Aitem) or else Is_Boolean_Aspect (Aspect))
@@ -2161,6 +2162,18 @@
Prepend (Aitem,
Visible_Declarations (Specification (N)));
+ elsif Nkind (N) = N_Package_Instantiation then
+ declare
+ Spec : constant Node_Id :=
+ Specification (Instance_Spec (N));
+ begin
+ if No (Visible_Declarations (Spec)) then
+ Set_Visible_Declarations (Spec, New_List);
+ end if;
+
+ Prepend (Aitem, Visible_Declarations (Spec));
+ end;
+
else
if No (Pragmas_After (Aux)) then
Set_Pragmas_After (Aux, New_List);
