[multiple changes]

2012-12-05  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Check_Loop_Invariant_Variant_Placement): When pragma
	Loop_[In]variant does not appear immediately within the statements
	of a loop, it must appear in a chain of nested blocks.

2012-12-05  Thomas Quinot  <quinot@adacore.com>

	* sem_ch13.adb: Minor reformatting.
	 Remove redundant assertion.

From-SVN: r194213

3 files changed, 89 insertions, 27 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c323d7c..89030d9 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,14 @@
+2012-12-05  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_prag.adb (Check_Loop_Invariant_Variant_Placement): When pragma
+	Loop_[In]variant does not appear immediately within the statements
+	of a loop, it must appear in a chain of nested blocks.
+
+2012-12-05  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_ch13.adb: Minor reformatting.
+	 Remove redundant assertion.
+
 2012-12-05  Thomas Quinot  <quinot@adacore.com>
 
 	* par_sco.adb, scos.ads, put_scos.adb, put_scos.ads,
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 8bdf27f..887b079 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -84,7 +84,7 @@ package body Sem_Ch13 is
 
    procedure Build_Predicate_Function (Typ : Entity_Id; N : Node_Id);
    --  If Typ has predicates (indicated by Has_Predicates being set for Typ,
-   --  then either there are pragma Invariant entries on the rep chain for the
+   --  then either there are pragma Predicate entries on the rep chain for the
    --  type (note that Predicate aspects are converted to pragma Predicate), or
    --  there are inherited aspects from a parent type, or ancestor subtypes.
    --  This procedure builds the spec and body for the Predicate function that
@@ -5423,9 +5423,9 @@ package body Sem_Ch13 is
    --  use this function even if checks are off, e.g. for membership tests.
 
    procedure Build_Predicate_Function (Typ : Entity_Id; N : Node_Id) is
-      Loc  : constant Source_Ptr := Sloc (Typ);
-      Spec : Node_Id;
-      SId  : Entity_Id;
+      Loc   : constant Source_Ptr := Sloc (Typ);
+      Spec  : Node_Id;
+      SId   : Entity_Id;
       FDecl : Node_Id;
       FBody : Node_Id;
 
@@ -5669,7 +5669,6 @@ package body Sem_Ch13 is
 
          --  Build function declaration
 
-         pragma Assert (Has_Predicates (Typ));
          SId :=
            Make_Defining_Identifier (Loc,
              Chars => New_External_Name (Chars (Typ), "Predicate"));
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index ddd8482..be5afe0 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -620,7 +620,7 @@ package body Sem_Prag is
 
       procedure Check_Loop_Invariant_Variant_Placement;
       --  Verify whether pragma Loop_Invariant or pragma Loop_Variant appear
-      --  immediately within the statements of the related loop.
+      --  immediately within a construct restricted to loops.
 
       procedure Check_Is_In_Decl_Part_Or_Package_Spec;
       --  Check that pragma appears in a declarative part, or in a package
@@ -1921,37 +1921,89 @@ package body Sem_Prag is
       --------------------------------------------
 
       procedure Check_Loop_Invariant_Variant_Placement is
-         Loop_Stmt : Node_Id;
+         procedure Placement_Error (Constr : Node_Id);
+         --  Node Constr denotes the last loop restricted construct before we
+         --  encountered an illegal relation between enclosing constructs. Emit
+         --  an error depending on what Constr was.
+
+         ---------------------
+         -- Placement_Error --
+         ---------------------
+
+         procedure Placement_Error (Constr : Node_Id) is
+         begin
+            if Nkind (Constr) = N_Pragma then
+               Error_Pragma
+                 ("pragma % must appear immediately within the statements " &
+                  "of a loop");
+            else
+               Error_Pragma_Arg
+                 ("block containing pragma % must appear immediately within " &
+                  "the statements of a loop", Constr);
+            end if;
+         end Placement_Error;
+
+         --  Local declarations
+
+         Prev : Node_Id;
+         Stmt : Node_Id;
+
+      --  Start of processing for Check_Loop_Invariant_Variant_Placement
 
       begin
-         --  Locate the enclosing loop statement (if any)
+         Prev := N;
+         Stmt := Parent (N);
+         while Present (Stmt) loop
 
-         Loop_Stmt := N;
-         while Present (Loop_Stmt) loop
-            if Nkind (Loop_Stmt) = N_Loop_Statement then
-               exit;
+            --  The pragma or previous block must appear immediately within the
+            --  current block's declarative or statement part.
+
+            if Nkind (Stmt) = N_Block_Statement then
+               if (No (Declarations (Stmt))
+                     or else List_Containing (Prev) /= Declarations (Stmt))
+                 and then
+                   List_Containing (Prev) /=
+                     Statements (Handled_Statement_Sequence (Stmt))
+               then
+                  Placement_Error (Prev);
+                  return;
 
-            --  Prevent the search from going too far
+               --  Keep inspecting the parents because we are now within a
+               --  chain of nested blocks.
+
+               else
+                  Prev := Stmt;
+                  Stmt := Parent (Stmt);
+               end if;
+
+            --  The pragma or previous block must appear immediately within the
+            --  statements of the loop.
+
+            elsif Nkind (Stmt) = N_Loop_Statement then
+               if List_Containing (Prev) /= Statements (Stmt) then
+                  Placement_Error (Prev);
+               end if;
+
+               --  Stop the traversal because we reached the innermost loop
+               --  regardless of whether we encountered an error or not.
 
-            elsif Nkind_In (Loop_Stmt, N_Entry_Body,
-                                       N_Package_Body,
-                                       N_Package_Declaration,
-                                       N_Protected_Body,
-                                       N_Subprogram_Body,
-                                       N_Task_Body)
-            then
-               Error_Pragma ("pragma % must appear inside a loop statement");
                return;
 
+            --  Ignore a handled statement sequence. Note that this node may
+            --  be related to a subprogram body in which case we will emit an
+            --  error on the next iteration of the search.
+
+            elsif Nkind (Stmt) = N_Handled_Sequence_Of_Statements then
+               Stmt := Parent (Stmt);
+
+            --  Any other statement breaks the chain from the pragma to the
+            --  loop.
+
             else
-               Loop_Stmt := Parent (Loop_Stmt);
+               Placement_Error (Prev);
+               return;
             end if;
          end loop;
-
-         if List_Containing (N) /= Statements (Loop_Stmt) then
-            Error_Pragma
-              ("pragma % must occur immediately in the statements of a loop");
-         end if;
       end Check_Loop_Invariant_Variant_Placement;
 
       -------------------------------------------