* trans.h (struct gfc_ss): New field nested_ss.

[pf3gnuchains/gcc-fork.git] / gcc / ada / sem_ch13.adb

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index fd7473c..d30ba09 100644 (file)
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -804,6 +804,19 @@ package body Sem_Ch13 is
                goto Continue;
             end if;
 
+            --  Check restriction No_Implementation_Aspect_Specifications
+
+            if Impl_Defined_Aspects (A_Id) then
+               Check_Restriction
+                 (No_Implementation_Aspect_Specifications, Aspect);
+            end if;
+
+            --  Check restriction No_Specification_Of_Aspect
+
+            Check_Restriction_No_Specification_Of_Aspect (Aspect);
+
+            --  Analyze this aspect
+
             Set_Analyzed (Aspect);
             Set_Entity (Aspect, E);
             Ent := New_Occurrence_Of (E, Sloc (Id));
@@ -1146,6 +1159,7 @@ package body Sem_Ch13 is
                         New_List (Ent, Relocate_Node (Expr)));
 
                   Set_From_Aspect_Specification (Aitem, True);
+                  Set_Corresponding_Aspect (Aitem, Aspect);
 
                   pragma Assert (not Delay_Required);
 
@@ -1181,6 +1195,7 @@ package body Sem_Ch13 is
                                    Expression => Relocate_Node (Expr))));
 
                      Set_From_Aspect_Specification (Aitem, True);
+                     Set_Corresponding_Aspect (Aitem, Aspect);
 
                      pragma Assert (not Delay_Required);
                   end;
@@ -1259,6 +1274,7 @@ package body Sem_Ch13 is
                   end if;
 
                   Set_From_Aspect_Specification (Aitem, True);
+                  Set_Corresponding_Aspect (Aitem, Aspect);
                   Set_Is_Delayed_Aspect (Aspect);
 
                   --  For Pre/Post cases, insert immediately after the entity
@@ -1289,25 +1305,9 @@ package body Sem_Ch13 is
                when Aspect_Invariant      |
                     Aspect_Type_Invariant =>
 
-                  --  Check placement legality: An invariant must apply to a
-                  --  private type, or appear in the private part of a spec.
-                  --  Analysis of the pragma will verify that in the private
-                  --  part it applies to a completion.
-
-                  if Nkind_In (N, N_Private_Type_Declaration,
-                                      N_Private_Extension_Declaration)
-                  then
-                     null;
-
-                  elsif Nkind (N) = N_Full_Type_Declaration
-                    and then In_Private_Part (Current_Scope)
-                  then
-                     null;
-
-                  else
-                     Error_Msg_N
-                       ("invariant aspect must apply to a private type", N);
-                  end if;
+                  --  Analysis of the pragma will verify placement legality:
+                  --  an invariant must apply to a private type, or appear in
+                  --  the private part of a spec and apply to a completion.
 
                   --  Construct the pragma
 
@@ -1332,6 +1332,7 @@ package body Sem_Ch13 is
                   end if;
 
                   Set_From_Aspect_Specification (Aitem, True);
+                  Set_Corresponding_Aspect (Aitem, Aspect);
                   Set_Is_Delayed_Aspect (Aspect);
 
                   --  For Invariant case, insert immediately after the entity
@@ -1361,14 +1362,7 @@ package body Sem_Ch13 is
                         Make_Identifier (Sloc (Id), Name_Predicate));
 
                   Set_From_Aspect_Specification (Aitem, True);
-
-                  --  Set special flags for dynamic/static cases
-
-                  if A_Id = Aspect_Dynamic_Predicate then
-                     Set_From_Dynamic_Predicate (Aitem);
-                  elsif A_Id = Aspect_Static_Predicate then
-                     Set_From_Static_Predicate (Aitem);
-                  end if;
+                  Set_Corresponding_Aspect (Aitem, Aspect);
 
                   --  Make sure we have a freeze node (it might otherwise be
                   --  missing in cases like subtype X is Y, and we would not
@@ -1409,7 +1403,10 @@ package body Sem_Ch13 is
 
                   Comp_Expr := First (Expressions (Expr));
                   while Present (Comp_Expr) loop
-                     Append (Relocate_Node (Comp_Expr), Args);
+                     Append
+                       (Make_Pragma_Argument_Association (Sloc (Comp_Expr),
+                          Expression => Relocate_Node (Comp_Expr)),
+                       Args);
                      Next (Comp_Expr);
                   end loop;
 
@@ -1442,6 +1439,7 @@ package body Sem_Ch13 is
                         Args);
 
                   Set_From_Aspect_Specification (Aitem, True);
+                  Set_Corresponding_Aspect (Aitem, Aspect);
                   Set_Is_Delayed_Aspect (Aspect);
 
                   --  Insert immediately after the entity declaration
@@ -1460,6 +1458,11 @@ package body Sem_Ch13 is
             if Delay_Required then
                if Present (Aitem) then
                   Set_From_Aspect_Specification (Aitem, True);
+
+                  if Nkind (Aitem) = N_Pragma then
+                     Set_Corresponding_Aspect (Aitem, Aspect);
+                  end if;
+
                   Set_Is_Delayed_Aspect (Aitem);
                   Set_Aspect_Rep_Item (Aspect, Aitem);
                end if;
@@ -1473,6 +1476,10 @@ package body Sem_Ch13 is
             else
                Set_From_Aspect_Specification (Aitem, True);
 
+               if Nkind (Aitem) = N_Pragma then
+                  Set_Corresponding_Aspect (Aitem, Aspect);
+               end if;
+
                --  If this is a compilation unit, we will put the pragma in
                --  the Pragmas_After list of the N_Compilation_Unit_Aux node.
 
@@ -3361,10 +3368,22 @@ package body Sem_Ch13 is
          --  No statements other than code statements, pragmas, and labels.
          --  Again we allow certain internally generated statements.
 
+         --  In Ada 2012, qualified expressions are names, and the code
+         --  statement is initially parsed as a procedure call.
+
          Stmt := First (Statements (HSS));
          while Present (Stmt) loop
             StmtO := Original_Node (Stmt);
-            if Comes_From_Source (StmtO)
+
+            --  A procedure call transformed into a code statement is OK.
+
+            if Ada_Version >= Ada_2012
+              and then Nkind (StmtO) = N_Procedure_Call_Statement
+              and then Nkind (Name (StmtO)) = N_Qualified_Expression
+            then
+               null;
+
+            elsif Comes_From_Source (StmtO)
               and then not Nkind_In (StmtO, N_Pragma,
                                             N_Label,
                                             N_Code_Statement)
@@ -4750,10 +4769,15 @@ package body Sem_Ch13 is
             if Nkind (Ritem) = N_Pragma
               and then Pragma_Name (Ritem) = Name_Predicate
             then
-               if From_Dynamic_Predicate (Ritem) then
-                  Dynamic_Predicate_Present := True;
-               elsif From_Static_Predicate (Ritem) then
-                  Static_Predicate_Present := Ritem;
+               if Present (Corresponding_Aspect (Ritem)) then
+                  case Chars (Identifier (Corresponding_Aspect (Ritem))) is
+                     when Name_Dynamic_Predicate =>
+                        Dynamic_Predicate_Present := True;
+                     when Name_Static_Predicate =>
+                        Static_Predicate_Present := Ritem;
+                     when others =>
+                        null;
+                  end case;
                end if;
 
                --  Acquire arguments