sem_ch12.adb (Analyze_Package_Instantiation): If the instantiation is a compilation...

2013-09-10  Ed Schonberg  <schonberg@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.

From-SVN: r202453

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 45ee022..86ca911 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,17 @@
+2013-09-10  Ed Schonberg  <schonberg@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.
+
 2013-09-10  Robert Dewar  <dewar@adacore.com>
 
        * einfo.adb, sem_prag.adb, rtsfind.ads: Minor reformatting.

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index b93d385..cd63875 100644 (file)
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -3912,6 +3912,7 @@ package body Sem_Ch12 is
          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 @@ package body Sem_Ch12 is
             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 @@ package body Sem_Ch12 is
       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;
 

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 37fd722..5f3eb84 100644 (file)
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -2112,7 +2112,8 @@ package body Sem_Ch13 is
             --  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 @@ package body Sem_Ch13 is
                      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);

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index e17b6e8..fd5b9a2 100644 (file)
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -15144,16 +15144,22 @@ package body Sem_Prag is
             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;

diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb
index 8526716..82d6ce5 100644 (file)
--- a/gcc/ada/sprint.adb
+++ b/gcc/ada/sprint.adb
@@ -2479,6 +2479,18 @@ package body Sprint is
             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 @@ package body Sprint is
             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");