[multiple changes]

2014-02-19  Yannick Moy  <moy@adacore.com>

	* gnat_rm.texi: Doc clarifications.

2014-02-19  Yannick Moy  <moy@adacore.com>

	* exp_util.adb (Remove_Side_Effects): Do not remove side-effects
	inside a generic.

2014-02-19  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Get_Cursor_Type): Obtain cursor type from
	specified First primitive, rather than by name.
	(Validate_Iterable_Aspect, Resolve_Iterable_Operation): Use it,
	and extend error checking for missing primitives and incorrect
	signatures.

2014-02-19  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Check_Pragma_Implemented): Detect additional
	errors when a Synchronization aspect on an overriding protected
	operation does not match the given aspect on the overridden
	operation of an ancestor interface.

2014-02-19  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Check_Loop_Pragma_Grouping): New routine.
	(Check_Loop_Pragma_Placement): Update
	comment on usage. Remove local variables Orig_Stmt and
	Within_Same_Sequence. Check that the current Loop_Invariant or
	Loop_Variant pragma is grouped together with other such pragmas.
	(Is_Loop_Pragma): New routine.
	(Prev_In_Loop): Removed.

From-SVN: r207894

6 files changed, 315 insertions, 185 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 9b3a28a..d801603 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,37 @@
+2014-02-19  Yannick Moy  <moy@adacore.com>
+
+	* gnat_rm.texi: Doc clarifications.
+
+2014-02-19  Yannick Moy  <moy@adacore.com>
+
+	* exp_util.adb (Remove_Side_Effects): Do not remove side-effects
+	inside a generic.
+
+2014-02-19  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch13.adb (Get_Cursor_Type): Obtain cursor type from
+	specified First primitive, rather than by name.
+	(Validate_Iterable_Aspect, Resolve_Iterable_Operation): Use it,
+	and extend error checking for missing primitives and incorrect
+	signatures.
+
+2014-02-19  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch3.adb (Check_Pragma_Implemented): Detect additional
+	errors when a Synchronization aspect on an overriding protected
+	operation does not match the given aspect on the overridden
+	operation of an ancestor interface.
+
+2014-02-19  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_prag.adb (Check_Loop_Pragma_Grouping): New routine.
+	(Check_Loop_Pragma_Placement): Update
+	comment on usage. Remove local variables Orig_Stmt and
+	Within_Same_Sequence. Check that the current Loop_Invariant or
+	Loop_Variant pragma is grouped together with other such pragmas.
+	(Is_Loop_Pragma): New routine.
+	(Prev_In_Loop): Removed.
+
 2014-02-19  Robert Dewar  <dewar@adacore.com>
 
 	* par-ch6.adb (P_Return): For extended return, end column lines
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index cab1774..d9ad0e1 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -6638,9 +6638,12 @@ package body Exp_Util is
    begin
       --  Handle cases in which there is nothing to do. In GNATprove mode,
       --  removal of side effects is useful for the light expansion of
-      --  renamings.
+      --  renamings. This removal should only occur when not inside a
+      --  generic and not doing a pre-analysis.
 
-      if not (Expander_Active or (Full_Analysis and GNATprove_Mode)) then
+      if not Expander_Active
+        and (Inside_A_Generic or not Full_Analysis or not GNATprove_Mode)
+      then
          return;
       end if;
 
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index eff462f..78c6052 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -4357,7 +4357,7 @@ achieving its purpose.
 
 Multiple @code{Loop_Invariant} and @code{Loop_Variant} pragmas that
 apply to the same loop should be grouped in the same sequence of
-statements, with only the same pragmas in between.
+statements.
 
 To aid in writing such invariants, the special attribute @code{Loop_Entry}
 may be used to refer to the value of an expression on entry to the loop. This
@@ -4456,7 +4456,7 @@ syntax.
 
 Multiple @code{Loop_Invariant} and @code{Loop_Variant} pragmas that
 apply to the same loop should be grouped in the same sequence of
-statements, with only the same pragmas in between.
+statements.
 
 The @code{Loop_Entry} attribute may be used within the expressions of the
 @code{Loop_Variant} pragma to refer to values on entry to the loop.
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 7c4d266..952e770 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -128,9 +128,11 @@ package body Sem_Ch13 is
    --  Uint value. If the value is inappropriate, then error messages are
    --  posted as required, and a value of No_Uint is returned.
 
-   function Get_Cursor_Type (S : Entity_Id) return Entity_Id;
-   --  Find Cursor type by name in the scope of an iterable type, for use in
-   --  resolving the primitive operations of the type.
+   function Get_Cursor_Type
+     (Aspect : Node_Id;
+       Typ   : Entity_Id) return Entity_Id;
+   --  Find Cursor type in scope of Typ, by locating primitive operation First.
+   --  For use in resolving the other primitive operations of an Iterable type.
 
    function Is_Operational_Item (N : Node_Id) return Boolean;
    --  A specification for a stream attribute is allowed before the full type
@@ -8059,16 +8061,25 @@ package body Sem_Ch13 is
             T := Entity (ASN);
 
             declare
-               Cursor : constant Entity_Id := Get_Cursor_Type (Scope (T));
+               Cursor : constant Entity_Id := Get_Cursor_Type (ASN, T);
                Assoc  : Node_Id;
                Expr   : Node_Id;
+
             begin
+               if Cursor = Any_Type then
+                  return;
+               end if;
+
                Assoc := First (Component_Associations (Expression (ASN)));
                while Present (Assoc) loop
                   Expr := Expression (Assoc);
                   Analyze (Expr);
-                  Resolve_Iterable_Operation
-                    (Expr, Cursor, T, Chars (First (Choices (Assoc))));
+
+                  if not Error_Posted (Expr) then
+                     Resolve_Iterable_Operation
+                       (Expr, Cursor, T, Chars (First (Choices (Assoc))));
+                  end if;
+
                   Next (Assoc);
                end loop;
             end;
@@ -9749,26 +9760,75 @@ package body Sem_Ch13 is
    -- Get_Cursor_Type --
    ---------------------
 
-   function Get_Cursor_Type (S : Entity_Id) return Entity_Id is
-      C : Entity_Id;
-      E : Entity_Id;
+   function Get_Cursor_Type
+     (Aspect : Node_Id;
+      Typ    : Entity_Id) return Entity_Id
+   is
+      Assoc    : Node_Id;
+      Func     : Entity_Id;
+      First_Op : Entity_Id;
+      Cursor   : Entity_Id;
 
    begin
-      --  There must be a cursor type declared in the same package, to be
-      --  used in iterable primitives.
-
-      C := Empty;
-      E := First_Entity (S);
-      while Present (E) loop
-         if Chars (E) = Name_Cursor and then Is_Type (E) then
-            C := E;
+      --  If error already detected, return.
+
+      if Error_Posted (Aspect) then
+         return Any_Type;
+      end if;
+
+      --  The cursor type for an Iterable aspect is the return type of
+      --  a non-overloaded First primitive operation. Locate association
+      --  for First.
+
+      Assoc := First (Component_Associations (Expression (Aspect)));
+      First_Op  := Any_Id;
+      while Present (Assoc) loop
+         if Chars (First (Choices (Assoc))) = Name_First then
+            First_Op := Expression (Assoc);
             exit;
          end if;
 
-         Next_Entity (E);
+         Next (Assoc);
+      end loop;
+
+      if First_Op = Any_Id then
+         Error_Msg_N ("aspect Iterable must specify First operation", Aspect);
+         return Any_Type;
+      end if;
+
+      Cursor := Any_Type;
+
+      --  Locate function with desired name and profile in scope of type.
+
+      Func := First_Entity (Scope (Typ));
+      while Present (Func) loop
+         if Chars (Func) = Chars (First_Op)
+           and then Ekind (Func) = E_Function
+           and then Present (First_Formal (Func))
+           and then Etype (First_Formal (Func)) = Typ
+           and then No (Next_Formal (First_Formal (Func)))
+         then
+            if Cursor /= Any_Type then
+               Error_Msg_N
+                  ("Operation First for iterable type must be unique", Aspect);
+               return Any_Type;
+
+            else
+               Cursor :=  Etype (Func);
+            end if;
+         end if;
+
+         Next_Entity (Func);
       end loop;
 
-      return C;
+      --  If not found, no way to resolve remaining primitives.
+
+      if Cursor = Any_Type then
+         Error_Msg_N
+            ("No legal primitive operation First for Iterable type", Aspect);
+      end if;
+
+      return Cursor;
    end Get_Cursor_Type;
 
    -------------------------------------
@@ -10876,6 +10936,7 @@ package body Sem_Ch13 is
          then
             Error_Msg_N ("iterable primitive must be local function name "
                          & "whose first formal is an iterable type", N);
+            return;
          end if;
 
          Ent := Entity (N);
@@ -11455,7 +11516,7 @@ package body Sem_Ch13 is
       Expr  : Node_Id;
 
       Prim   : Node_Id;
-      Cursor : constant Entity_Id := Get_Cursor_Type (Scope (Typ));
+      Cursor : constant Entity_Id := Get_Cursor_Type (ASN, Typ);
 
       First_Id       : Entity_Id;
       Next_Id        : Entity_Id;
@@ -11463,8 +11524,9 @@ package body Sem_Ch13 is
       Element_Id     : Entity_Id;
 
    begin
-      if No (Cursor) then
-         Error_Msg_N ("Iterable aspect requires a cursor type", ASN);
+      --  If previous error aspect is unusable.
+
+      if Cursor = Any_Type then
          return;
       end if;
 
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index c763bd6..daa4f4e 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -9377,7 +9377,26 @@ package body Sem_Ch3 is
                Error_Msg_NE
                  ("type & must implement abstract subprogram & with a " &
                   "procedure", Subp_Alias, Contr_Typ);
+
+            elsif Present (Get_Rep_Pragma (Impl_Subp, Name_Implemented))
+              and then Implementation_Kind (Impl_Subp) /= Impl_Kind
+            then
+               Error_Msg_Name_1 := Impl_Kind;
+               Error_Msg_N
+                ("overriding operation& must have synchronization%",
+                   Subp_Alias);
             end if;
+
+         --  If primitive has Optional synchronization, overriding operation
+         --  must match if it has an explicit synchronization..
+
+         elsif Present (Get_Rep_Pragma (Impl_Subp, Name_Implemented))
+           and then Implementation_Kind (Impl_Subp) /= Impl_Kind
+         then
+               Error_Msg_Name_1 := Impl_Kind;
+               Error_Msg_N
+                ("overriding operation& must have syncrhonization%",
+                   Subp_Alias);
          end if;
       end Check_Pragma_Implemented;
 
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index a554e84..b7d8674 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -3103,10 +3103,9 @@ package body Sem_Prag is
       --  pragma Attach_Handler.
 
       procedure Check_Loop_Pragma_Placement;
-      --  Verify whether pragma Loop_Invariant or Loop_Optimize or Loop_Variant
+      --  Verify whether pragmas Loop_Invariant, Loop_Optimize and Loop_Variant
       --  appear immediately within a construct restricted to loops, and that
-      --  pragmas Loop_Invariant and Loop_Variant applying to the same loop all
-      --  appear grouped in the same sequence of statements.
+      --  pragmas Loop_Invariant and Loop_Variant are grouped together.
 
       procedure Check_Is_In_Decl_Part_Or_Package_Spec;
       --  Check that pragma appears in a declarative part, or in a package
@@ -4576,140 +4575,209 @@ package body Sem_Prag is
       ---------------------------------
 
       procedure Check_Loop_Pragma_Placement is
+         procedure Check_Loop_Pragma_Grouping (Loop_Stmt : Node_Id);
+         --  Verify whether the current pragma is properly grouped with other
+         --  pragma Loop_Invariant and/or Loop_Variant. Node Loop_Stmt is the
+         --  related loop where the pragma appears.
+
+         function Is_Loop_Pragma (Stmt : Node_Id) return Boolean;
+         --  Determine whether an arbitrary statement Stmt denotes pragma
+         --  Loop_Invariant or Loop_Variant.
+
          procedure Placement_Error (Constr : Node_Id);
          pragma No_Return (Placement_Error);
          --  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.
 
-         function Prev_In_Loop (Stmt : Node_Id) return Node_Id;
-         --  Returns the statement or declaration preceding Stmt in the
-         --  same loop, or Empty if the head of the loop is reached. Block
-         --  statements are entered during this traversal.
+         --------------------------------
+         -- Check_Loop_Pragma_Grouping --
+         --------------------------------
 
-         ---------------------
-         -- Placement_Error --
-         ---------------------
+         procedure Check_Loop_Pragma_Grouping (Loop_Stmt : Node_Id) is
+            Stop_Search : exception;
+            --  This exception is used to terminate the recursive descent of
+            --  routine Check_Grouping.
 
-         procedure Placement_Error (Constr : Node_Id) is
-            LA : constant String := " with Loop_Entry";
-         begin
-            if Prag_Id = Pragma_Assert then
-               Error_Msg_String (1 .. LA'Length) := LA;
-               Error_Msg_Strlen := LA'Length;
-            else
-               Error_Msg_Strlen := 0;
-            end if;
+            procedure Check_Grouping (L : List_Id);
+            --  Find the first group of pragmas in list L and if successful,
+            --  ensure that the current pragma is part of that group. The
+            --  routine raises Stop_Search once such a check is performed to
+            --  halt the recursive descent.
 
-            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;
+            procedure Grouping_Error (Prag : Node_Id);
+            pragma No_Return (Grouping_Error);
+            --  Emit an error concerning the current pragma indicating that it
+            --  should be placed after pragma Prag.
 
-         ------------------
-         -- Prev_In_Loop --
-         ------------------
+            --------------------
+            -- Check_Grouping --
+            --------------------
 
-         function Prev_In_Loop (Stmt : Node_Id) return Node_Id is
-            Prev : Node_Id;
-            Reach_Inside_Blocks : Boolean;
+            procedure Check_Grouping (L : List_Id) is
+               HSS  : Node_Id;
+               Prag : Node_Id;
+               Stmt : Node_Id;
 
-         begin
-            Reach_Inside_Blocks := True;
+            begin
+               --  Inspect the list of declarations or statements looking for
+               --  the first grouping of pragmas:
 
-            --  Try the previous statement in the same list
+               --    loop
+               --       pragma Loop_Invariant ...;
+               --       pragma Loop_Variant ...;
+               --       . . .                     -- (1)
+               --       pragma Loop_Variant ...;  --  current pragma
 
-            Prev := Nlists.Prev (Stmt);
+               --  If the current pragma is not in the grouping, then it must
+               --  either appear in a different declarative or statement list
+               --  or the construct at (1) is separating the pragma from the
+               --  grouping.
 
-            --  Otherwise reach to the previous statement through the parent
+               Stmt := First (L);
+               while Present (Stmt) loop
 
-            if No (Prev) then
+                  --  Pragmas Loop_Invariant and Loop_Variant may only appear
+                  --  inside a loop or a block housed inside a loop. Inspect
+                  --  the declarations and statements of the block as they may
+                  --  contain the first grouping.
 
-               --  If we're inside the statements of a block which contains
-               --  declarations, continue with the last declaration of the
-               --  block if any.
+                  if Nkind (Stmt) = N_Block_Statement then
+                     HSS := Handled_Statement_Sequence (Stmt);
 
-               if Nkind (Parent (Stmt)) = N_Handled_Sequence_Of_Statements
-                 and then Nkind (Parent (Parent (Stmt))) = N_Block_Statement
-                 and then Present (Declarations (Parent (Parent (Stmt))))
-               then
-                  Prev := Last (Declarations (Parent (Parent (Stmt))));
+                     Check_Grouping (Declarations (Stmt));
 
-               --  Ignore a handled statement sequence
+                     if Present (HSS) then
+                        Check_Grouping (Statements (HSS));
+                     end if;
 
-               elsif
-                 Nkind (Parent (Stmt)) = N_Handled_Sequence_Of_Statements
-               then
-                  Reach_Inside_Blocks := False;
-                  Prev := Parent (Parent (Stmt));
+                  --  The first pragma of the first topmost grouping has been
+                  --  found.
 
-               --  Do not reach past the head of the current loop
+                  elsif Is_Loop_Pragma (Stmt) then
 
-               elsif Nkind (Parent (Stmt)) = N_Loop_Statement then
-                  null;
+                     --  The group and the current pragma are not in the same
+                     --  declarative or statement list.
 
-               --  Otherwise use the parent statement
+                     if List_Containing (Stmt) /= List_Containing (N) then
+                        Grouping_Error (Stmt);
 
-               else
-                  Reach_Inside_Blocks := False;
-                  Prev := Parent (Stmt);
-               end if;
-            end if;
+                     --  Try to reach the current pragma from the first pragma
+                     --  of the grouping while skipping other members:
 
-            --  Skip block statements
+                     --    pragma Loop_Invariant ...;  --  first pragma
+                     --    pragma Loop_Variant ...;    --  member
+                     --    . . .
+                     --    pragma Loop_Variant ...;    --  current pragma
 
-            while Nkind (Prev) = N_Block_Statement loop
+                     else
+                        while Present (Stmt) loop
 
-               --  If a block is reached from statements that follow it, then
-               --  we should reach inside the block to its last contained
-               --  statement.
+                           --  The current pragma is either the first pragma
+                           --  of the group or is a member of the group. Stop
+                           --  the search as the placement is legal.
 
-               if Reach_Inside_Blocks then
-                  Prev :=
-                    Last (Statements (Handled_Statement_Sequence (Prev)));
+                           if Stmt = N then
+                              raise Stop_Search;
 
-               --  If a block is reached from statements and declarations
-               --  inside it, continue with the statements preceding the
-               --  block if any.
+                           --  Skip group members, but keep track of the last
+                           --  pragma in the group.
 
-               elsif Present (Nlists.Prev (Prev)) then
-                  Reach_Inside_Blocks := True;
-                  Prev := Nlists.Prev (Prev);
+                           elsif Is_Loop_Pragma (Stmt) then
+                              Prag := Stmt;
 
-               --  Ignore a handled statement sequence
+                           --  A non-pragma is separating the group from the
+                           --  current pragma, the placement is erroneous.
 
-               elsif
-                 Nkind (Parent (Prev)) = N_Handled_Sequence_Of_Statements
-               then
-                  Prev := Parent (Parent (Prev));
+                           else
+                              Grouping_Error (Prag);
+                           end if;
 
-               --  Do not reach past the head of the current loop
+                           Next (Stmt);
+                        end loop;
 
-               elsif Nkind (Parent (Prev)) = N_Loop_Statement then
-                  Prev := Empty;
+                        --  If the traversal did not reach the current pragma,
+                        --  then the list must be malformed.
 
-               --  Otherwise use the parent statement
+                        raise Program_Error;
+                     end if;
+                  end if;
 
-               else
-                  Prev := Parent (Prev);
-               end if;
-            end loop;
+                  Next (Stmt);
+               end loop;
+            end Check_Grouping;
+
+            --------------------
+            -- Grouping_Error --
+            --------------------
+
+            procedure Grouping_Error (Prag : Node_Id) is
+            begin
+               Error_Msg_Sloc := Sloc (Prag);
+               Error_Pragma ("pragma% must appear immediately after pragma#");
+            end Grouping_Error;
+
+         --  Start of processing for Check_Loop_Pragma_Grouping
+
+         begin
+            --  Inspect the statements of the loop or nested blocks housed
+            --  within to determine whether the current pragma is part of the
+            --  first topmost grouping of Loop_Invariant and Loop_Variant.
+
+            Check_Grouping (Statements (Loop_Stmt));
 
-            return Prev;
-         end Prev_In_Loop;
+         exception
+            when Stop_Search => null;
+         end Check_Loop_Pragma_Grouping;
+
+         --------------------
+         -- Is_Loop_Pragma --
+         --------------------
+
+         function Is_Loop_Pragma (Stmt : Node_Id) return Boolean is
+         begin
+            --  Inspect the original node as Loop_Invariant and Loop_Variant
+            --  pragmas are rewritten to null when assertions are disabled.
+
+            if Nkind (Original_Node (Stmt)) = N_Pragma then
+               return
+                 Nam_In (Pragma_Name (Original_Node (Stmt)),
+                         Name_Loop_Invariant,
+                         Name_Loop_Variant);
+            else
+               return False;
+            end if;
+         end Is_Loop_Pragma;
+
+         ---------------------
+         -- Placement_Error --
+         ---------------------
+
+         procedure Placement_Error (Constr : Node_Id) is
+            LA : constant String := " with Loop_Entry";
+         begin
+            if Prag_Id = Pragma_Assert then
+               Error_Msg_String (1 .. LA'Length) := LA;
+               Error_Msg_Strlen := LA'Length;
+            else
+               Error_Msg_Strlen := 0;
+            end if;
+
+            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;
-         Orig_Stmt            : Node_Id;
-         Within_Same_Sequence : Boolean;
+         Prev : Node_Id;
+         Stmt : Node_Id;
 
       --  Start of processing for Check_Loop_Pragma_Placement
 
@@ -4771,71 +4839,15 @@ package body Sem_Prag is
             end if;
          end loop;
 
-         --  For a Loop_Invariant or Loop_Variant pragma, check that previous
-         --  Loop_Invariant and Loop_Variant pragmas for the same loop appear
-         --  in the same sequence of statements, with only intervening similar
-         --  pragmas.
-
-         if Prag_Id = Pragma_Loop_Invariant
-              or else
-            Prag_Id = Pragma_Loop_Variant
-         then
-            Stmt := Prev_In_Loop (N);
-            Within_Same_Sequence := True;
-
-            while Present (Stmt) loop
-
-               --  The pragma may have been rewritten as a null statement if
-               --  assertions are not enabled, in which case the original node
-               --  should be used.
-
-               Orig_Stmt := Original_Node (Stmt);
+         --  Check that the current pragma Loop_Invariant or Loop_Variant is
+         --  grouped together with other such pragmas.
 
-               --  Issue an error on a non-consecutive Loop_Invariant or
-               --  Loop_Variant pragma.
+         if Is_Loop_Pragma (N) then
 
-               if Nkind (Orig_Stmt) = N_Pragma then
-                  declare
-                     Stmt_Prag_Id : constant Pragma_Id :=
-                                      Get_Pragma_Id (Pragma_Name (Orig_Stmt));
+            --  The previous check should have located the related loop
 
-                  begin
-                     if Stmt_Prag_Id = Pragma_Loop_Invariant
-                          or else
-                        Stmt_Prag_Id = Pragma_Loop_Variant
-                     then
-                        if List_Containing (Stmt) /= List_Containing (N)
-                          or else not Within_Same_Sequence
-                        then
-                           Error_Msg_Sloc := Sloc (Orig_Stmt);
-                           Error_Pragma
-                             ("pragma% must appear immediately after pragma#");
-
-                        --  Continue searching for previous Loop_Invariant and
-                        --  Loop_Variant pragmas even after finding a previous
-                        --  correct pragma, so that an error is also issued
-                        --  for the current pragma in case there is a previous
-                        --  non-consecutive pragma.
-
-                        else
-                           null;
-                        end if;
-
-                     --  Mark the end of the consecutive sequence of pragmas
-
-                     else
-                        Within_Same_Sequence := False;
-                     end if;
-                  end;
-
-               --  Mark the end of the consecutive sequence of pragmas
-
-               else
-                  Within_Same_Sequence := False;
-               end if;
-
-               Stmt := Prev_In_Loop (Stmt);
-            end loop;
+            pragma Assert (Nkind (Stmt) = N_Loop_Statement);
+            Check_Loop_Pragma_Grouping (Stmt);
          end if;
       end Check_Loop_Pragma_Placement;