[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

gcc/ada/ChangeLog

+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

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;
 

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.

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;
 

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;