[multiple changes]

2014-02-19  Robert Dewar  <dewar@adacore.com>

	* exp_attr.adb (Expand_Min_Max_Attribute): Use Insert_Declaration
	(Expand_Min_Max_Attribute): Use Matching_Standard_Type.
	* exp_ch4.adb (Expand_N_Expression_With_Actions): Remove special
	handling for the case of Modify_Tree_For_C, this approach did
	not work.
	* exp_util.adb (Matching_Standard_Type): New function
	(Side_Effect_Free): New top level functions (from
	Remove_Side_Effects).
	* exp_util.ads (Side_Effect_Free): New top level functions
	(moved from body).
	* sinfo.ads: Minor comment updates.

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

	* exp_ch6.adb (Expand_Simple_Function_Return): If return
	type is unconstrained and uses the secondary stack, mark the
	enclosing function accordingly, to ensure that the value is not
	prematurely removed.

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

	* par.adb Alphabetize the routines in Par.Sync.
	(Resync_Past_Malformed_Aspect): New routine.
	* par-ch13.adb (Get_Aspect_Specifications): Alphabetize local
	variables. Code and comment reformatting. Detect missing
	parentheses on aspects [Refined_]Global and [Refined_]Depends
	with a non-null definition.
	* par-sync.adb: Alphabetize all routines in this separate unit.
	(Resync_Past_Malformed_Aspect): New routine.

From-SVN: r207890

10 files changed, 862 insertions, 668 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 243878d..e8f0c63 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,37 @@
 2014-02-19  Robert Dewar  <dewar@adacore.com>
 
+	* exp_attr.adb (Expand_Min_Max_Attribute): Use Insert_Declaration
+	(Expand_Min_Max_Attribute): Use Matching_Standard_Type.
+	* exp_ch4.adb (Expand_N_Expression_With_Actions): Remove special
+	handling for the case of Modify_Tree_For_C, this approach did
+	not work.
+	* exp_util.adb (Matching_Standard_Type): New function
+	(Side_Effect_Free): New top level functions (from
+	Remove_Side_Effects).
+	* exp_util.ads (Side_Effect_Free): New top level functions
+	(moved from body).
+	* sinfo.ads: Minor comment updates.
+
+2014-02-19  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch6.adb (Expand_Simple_Function_Return): If return
+	type is unconstrained and uses the secondary stack, mark the
+	enclosing function accordingly, to ensure that the value is not
+	prematurely removed.
+
+2014-02-19  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* par.adb Alphabetize the routines in Par.Sync.
+	(Resync_Past_Malformed_Aspect): New routine.
+	* par-ch13.adb (Get_Aspect_Specifications): Alphabetize local
+	variables. Code and comment reformatting. Detect missing
+	parentheses on aspects [Refined_]Global and [Refined_]Depends
+	with a non-null definition.
+	* par-sync.adb: Alphabetize all routines in this separate unit.
+	(Resync_Past_Malformed_Aspect): New routine.
+
+2014-02-19  Robert Dewar  <dewar@adacore.com>
+
 	* sem_eval.ads, sem_eval.adb (Subtypes_Statically_Match): Return False
 	if Esize values do not match.
 
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 21472b6..2e370ac 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -1062,8 +1062,6 @@ package body Exp_Attr is
             Expr  : constant Node_Id    := First (Expressions (N));
             Left  : constant Node_Id    := Relocate_Node (Expr);
             Right : constant Node_Id    := Relocate_Node (Next (Expr));
-            Ltyp  : constant Entity_Id  := Etype (Left);
-            Rtyp  : constant Entity_Id  := Etype (Right);
 
             function Make_Compare (Left, Right : Node_Id) return Node_Id;
             --  Returns Left >= Right for Max, Left <= Right for Min
@@ -1090,12 +1088,12 @@ package body Exp_Attr is
          --  Start of processing for Min_Max
 
          begin
-            --  If both Left and Right are simple entity names, then we can
-            --  just use Duplicate_Expr to duplicate the references and return
+            --  If both Left and Right are side effect free, then we can just
+            --  use Duplicate_Expr to duplicate the references and return
 
             --    (if Left >=|<= Right then Left else Right)
 
-            if Is_Entity_Name (Left) and then Is_Entity_Name (Right) then
+            if Side_Effect_Free (Left) and then Side_Effect_Free (Right) then
                Rewrite (N,
                  Make_If_Expression (Loc,
                    Expressions => New_List (
@@ -1103,35 +1101,57 @@ package body Exp_Attr is
                      Duplicate_Subexpr_No_Checks (Left),
                      Duplicate_Subexpr_No_Checks (Right))));
 
-            --  Otherwise we wrap things in an expression with actions. You
-            --  might think we could just use the approach above, but there
-            --  are problems, in particular with escaped discriminants. In
-            --  this case we generate:
+            --  Otherwise we generate declarations to capture the values. We
+            --  can't put these declarations inside the if expression, since
+            --  we could end up with an N_Expression_With_Actions which has
+            --  declarations in the actions, forbidden for Modify_Tree_For_C.
+
+            --  The translation is
+
+            --    T1 : styp;    --  inserted high up in tree
+            --    T2 : styp;    --  inserted high up in tree
 
             --    do
-            --      T1 : constant typ := Left;
-            --      T2 : constant typ := Right;
+            --      T1 := styp!(Left);
+            --      T2 := styp!(Right);
             --    in
-            --      (if T1 >=|<= T2 then T1 else T2)
+            --      (if T1 >=|<= T2 then typ!(T1) else typ!(T2))
             --    end;
 
+            --  We insert the T1,T2 declarations with Insert_Declaration which
+            --  inserts these declarations high up in the tree unconditionally.
+            --  This is safe since no code is associated with the declarations.
+            --  Here styp is a standard type whose Esize matches the size of
+            --  our type. We do this because the actual type may be a result of
+            --  some local declaration which would not be visible at the point
+            --  where we insert the declarations of T1 and T2.
+
             else
                declare
-                  T1 : constant Entity_Id := Make_Temporary (Loc, 'T', Left);
-                  T2 : constant Entity_Id := Make_Temporary (Loc, 'T', Left);
+                  T1   : constant Entity_Id := Make_Temporary (Loc, 'T', Left);
+                  T2   : constant Entity_Id := Make_Temporary (Loc, 'T', Left);
+                  Styp : constant Entity_Id := Matching_Standard_Type (Typ);
 
                begin
+                  Insert_Declaration (N,
+                    Make_Object_Declaration (Loc,
+                      Defining_Identifier => T1,
+                      Object_Definition   => New_Occurrence_Of (Styp, Loc)));
+
+                  Insert_Declaration (N,
+                    Make_Object_Declaration (Loc,
+                      Defining_Identifier => T2,
+                      Object_Definition   => New_Occurrence_Of (Styp, Loc)));
+
                   Rewrite (N,
                     Make_Expression_With_Actions (Loc,
                       Actions => New_List (
-                        Make_Object_Declaration (Loc,
-                          Defining_Identifier => T1,
-                          Object_Definition   => New_Occurrence_Of (Ltyp, Loc),
-                          Expression          => Left),
-                        Make_Object_Declaration (Loc,
-                          Defining_Identifier => T2,
-                          Object_Definition   => New_Occurrence_Of (Rtyp, Loc),
-                          Expression          => Right)),
+                        Make_Assignment_Statement (Loc,
+                          Name       => New_Occurrence_Of (T1, Loc),
+                          Expression => Unchecked_Convert_To (Styp, Left)),
+                        Make_Assignment_Statement (Loc,
+                          Name       => New_Occurrence_Of (T2, Loc),
+                          Expression => Unchecked_Convert_To (Styp, Right))),
 
                       Expression =>
                         Make_If_Expression (Loc,
@@ -1139,8 +1159,10 @@ package body Exp_Attr is
                             Make_Compare
                               (New_Occurrence_Of (T1, Loc),
                                New_Occurrence_Of (T2, Loc)),
-                            New_Occurrence_Of (T1, Loc),
-                            New_Occurrence_Of (T2, Loc)))));
+                            Unchecked_Convert_To (Typ,
+                              New_Occurrence_Of (T1, Loc)),
+                            Unchecked_Convert_To (Typ,
+                              New_Occurrence_Of (T2, Loc))))));
                end;
             end if;
 
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index b9ff98c..512ebd8 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -5067,14 +5067,6 @@ package body Exp_Ch4 is
    --------------------------------------
 
    procedure Expand_N_Expression_With_Actions (N : Node_Id) is
-      procedure Insert_Declaration (Decl : Node_Id);
-      --  This is like Insert_Action, but inserts outside the expression in
-      --  which N appears. This is needed, because otherwise we can end up
-      --  inserting a declaration in the actions of a short circuit, and that
-      --  will not do, because that's likely where we (the expression with
-      --  actions) node came from the first place. We are only inserting a
-      --  declaration with no side effects, so it is harmless (and needed)
-      --  to insert at a higher point in the tree.
 
       function Process_Action (Act : Node_Id) return Traverse_Result;
       --  Inspect and process a single action of an expression_with_actions for
@@ -5082,27 +5074,6 @@ package body Exp_Ch4 is
       --  generates code to clean them up when the context of the expression is
       --  evaluated or elaborated.
 
-      ------------------------
-      -- Insert_Declaration --
-      ------------------------
-
-      procedure Insert_Declaration (Decl : Node_Id) is
-         P : Node_Id;
-
-      begin
-         --  Climb out of the current expression
-
-         P := Decl;
-         loop
-            exit when Nkind (Parent (P)) not in N_Subexpr;
-            P := Parent (P);
-         end loop;
-
-         --  Now do the insertion
-
-         Insert_Action (P, Decl);
-      end Insert_Declaration;
-
       --------------------
       -- Process_Action --
       --------------------
@@ -5135,11 +5106,7 @@ package body Exp_Ch4 is
 
       --  Local variables
 
-      Loc : Source_Ptr;
       Act : Node_Id;
-      Def : Entity_Id;
-      Exp : Node_Id;
-      Nxt : Node_Id;
 
    --  Start of processing for Expand_N_Expression_With_Actions
 
@@ -5152,48 +5119,6 @@ package body Exp_Ch4 is
          Next (Act);
       end loop;
 
-      --  In Modify_Tree_For_C, we have trouble in C with object declarations
-      --  in the actions list (expressions are fine). So if we have an object
-      --  declaration, insert it higher in the tree, if necessary replacing it
-      --  with an assignment to capture initialization.
-
-      if Modify_Tree_For_C then
-         Act := First (Actions (N));
-         while Present (Act) loop
-            if Nkind (Act) = N_Object_Declaration then
-               Def := Defining_Identifier (Act);
-               Exp := Expression (Act);
-               Set_Constant_Present (Act, False);
-               Set_Expression (Act, Empty);
-               Insert_Declaration (Relocate_Node (Act));
-
-               Loc := Sloc (Act);
-
-               --  Expression present, rewrite as assignment, get next action
-
-               if Present (Exp) then
-                  Rewrite (Act,
-                    Make_Assignment_Statement (Loc,
-                      Name       => New_Occurrence_Of (Def, Loc),
-                      Expression => Exp));
-                  Next (Act);
-
-               --  No expression, remove action and move to next
-
-               else
-                  Nxt := Next (Act);
-                  Remove (Act);
-                  Act := Nxt;
-               end if;
-
-            --  Not an object declaration, move to next action
-
-            else
-               Next (Act);
-            end if;
-         end loop;
-      end if;
-
       --  Deal with case where there are no actions. In this case we simply
       --  rewrite the node with its expression since we don't need the actions
       --  and the specification of this node does not allow a null action list.
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 3908584..e1c4722 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -7834,6 +7834,13 @@ package body Exp_Ch6 is
                Set_Sec_Stack_Needed_For_Return (S, True);
                S := Enclosing_Dynamic_Scope (S);
             end loop;
+
+            --  The enclosing function itself must be marked as well, to
+            --  prevent premature secondary stack cleanup.
+
+            if Ekind (S) = E_Function then
+               Set_Sec_Stack_Needed_For_Return (Scope_Id);
+            end if;
          end;
 
          --  Optimize the case where the result is a function call. In this
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 27559d7..251e919 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -3962,11 +3962,13 @@ package body Exp_Util is
 
       --  Climb until we find a procedure or a package
 
-      P := Parent (N);
+      P := N;
       loop
+         pragma Assert (Present (Parent (P)));
+         P := Parent (P);
+
          if Is_List_Member (P) then
             exit when Nkind_In (Parent (P), N_Package_Specification,
-                                            N_Package_Body,
                                             N_Subprogram_Body);
 
             --  Special handling for handled sequence of statements, we must
@@ -3977,8 +3979,6 @@ package body Exp_Util is
                exit;
             end if;
          end if;
-
-         P := Parent (P);
       end loop;
 
       --  Now do the insertion
@@ -5970,7 +5970,7 @@ package body Exp_Util is
       Siz : constant Uint := Esize (Typ);
 
    begin
-      --  Float-point cases
+      --  Floating-point cases
 
       if Is_Floating_Point_Type (Typ) then
          if Siz <= Esize (Standard_Short_Float) then
@@ -5987,7 +5987,7 @@ package body Exp_Util is
 
       --  Integer cases (includes fixed-point types)
 
-      --  Unsigned cases (includes normal enumeration types)
+      --  Unsigned integer cases (includes normal enumeration types)
 
       elsif Is_Unsigned_Type (Typ) then
          if Siz <= Esize (Standard_Short_Short_Unsigned) then
@@ -6004,7 +6004,7 @@ package body Exp_Util is
             raise Program_Error;
          end if;
 
-      --  Signed cases
+      --  Signed integer cases
 
       else
          if Siz <= Esize (Standard_Short_Short_Integer) then
@@ -6635,435 +6635,6 @@ package body Exp_Util is
       Ref_Type     : Entity_Id;
       Res          : Node_Id;
 
-      function Side_Effect_Free (N : Node_Id) return Boolean;
-      --  Determines if the tree N represents an expression that is known not
-      --  to have side effects, and for which no processing is required.
-
-      function Side_Effect_Free (L : List_Id) return Boolean;
-      --  Determines if all elements of the list L are side effect free
-
-      function Safe_Prefixed_Reference (N : Node_Id) return Boolean;
-      --  The argument N is a construct where the Prefix is dereferenced if it
-      --  is an access type and the result is a variable. The call returns True
-      --  if the construct is side effect free (not considering side effects in
-      --  other than the prefix which are to be tested by the caller).
-
-      function Within_In_Parameter (N : Node_Id) return Boolean;
-      --  Determines if N is a subcomponent of a composite in-parameter. If so,
-      --  N is not side-effect free when the actual is global and modifiable
-      --  indirectly from within a subprogram, because it may be passed by
-      --  reference. The front-end must be conservative here and assume that
-      --  this may happen with any array or record type. On the other hand, we
-      --  cannot create temporaries for all expressions for which this
-      --  condition is true, for various reasons that might require clearing up
-      --  ??? For example, discriminant references that appear out of place, or
-      --  spurious type errors with class-wide expressions. As a result, we
-      --  limit the transformation to loop bounds, which is so far the only
-      --  case that requires it.
-
-      -----------------------------
-      -- Safe_Prefixed_Reference --
-      -----------------------------
-
-      function Safe_Prefixed_Reference (N : Node_Id) return Boolean is
-      begin
-         --  If prefix is not side effect free, definitely not safe
-
-         if not Side_Effect_Free (Prefix (N)) then
-            return False;
-
-         --  If the prefix is of an access type that is not access-to-constant,
-         --  then this construct is a variable reference, which means it is to
-         --  be considered to have side effects if Variable_Ref is set True.
-
-         elsif Is_Access_Type (Etype (Prefix (N)))
-           and then not Is_Access_Constant (Etype (Prefix (N)))
-           and then Variable_Ref
-         then
-            --  Exception is a prefix that is the result of a previous removal
-            --  of side-effects.
-
-            return Is_Entity_Name (Prefix (N))
-              and then not Comes_From_Source (Prefix (N))
-              and then Ekind (Entity (Prefix (N))) = E_Constant
-              and then Is_Internal_Name (Chars (Entity (Prefix (N))));
-
-         --  If the prefix is an explicit dereference then this construct is a
-         --  variable reference, which means it is to be considered to have
-         --  side effects if Variable_Ref is True.
-
-         --  We do NOT exclude dereferences of access-to-constant types because
-         --  we handle them as constant view of variables.
-
-         elsif Nkind (Prefix (N)) = N_Explicit_Dereference
-           and then Variable_Ref
-         then
-            return False;
-
-         --  Note: The following test is the simplest way of solving a complex
-         --  problem uncovered by the following test (Side effect on loop bound
-         --  that is a subcomponent of a global variable:
-
-         --    with Text_Io; use Text_Io;
-         --    procedure Tloop is
-         --      type X is
-         --        record
-         --          V : Natural := 4;
-         --          S : String (1..5) := (others => 'a');
-         --        end record;
-         --      X1 : X;
-
-         --      procedure Modi;
-
-         --      generic
-         --        with procedure Action;
-         --      procedure Loop_G (Arg : X; Msg : String)
-
-         --      procedure Loop_G (Arg : X; Msg : String) is
-         --      begin
-         --        Put_Line ("begin loop_g " & Msg & " will loop till: "
-         --                  & Natural'Image (Arg.V));
-         --        for Index in 1 .. Arg.V loop
-         --          Text_Io.Put_Line
-         --            (Natural'Image (Index) & " " & Arg.S (Index));
-         --          if Index > 2 then
-         --            Modi;
-         --          end if;
-         --        end loop;
-         --        Put_Line ("end loop_g " & Msg);
-         --      end;
-
-         --      procedure Loop1 is new Loop_G (Modi);
-         --      procedure Modi is
-         --      begin
-         --        X1.V := 1;
-         --        Loop1 (X1, "from modi");
-         --      end;
-         --
-         --    begin
-         --      Loop1 (X1, "initial");
-         --    end;
-
-         --  The output of the above program should be:
-
-         --    begin loop_g initial will loop till:  4
-         --     1 a
-         --     2 a
-         --     3 a
-         --    begin loop_g from modi will loop till:  1
-         --     1 a
-         --    end loop_g from modi
-         --     4 a
-         --    begin loop_g from modi will loop till:  1
-         --     1 a
-         --    end loop_g from modi
-         --    end loop_g initial
-
-         --  If a loop bound is a subcomponent of a global variable, a
-         --  modification of that variable within the loop may incorrectly
-         --  affect the execution of the loop.
-
-         elsif Nkind (Parent (Parent (N))) = N_Loop_Parameter_Specification
-           and then Within_In_Parameter (Prefix (N))
-           and then Variable_Ref
-         then
-            return False;
-
-         --  All other cases are side effect free
-
-         else
-            return True;
-         end if;
-      end Safe_Prefixed_Reference;
-
-      ----------------------
-      -- Side_Effect_Free --
-      ----------------------
-
-      function Side_Effect_Free (N : Node_Id) return Boolean is
-      begin
-         --  Note on checks that could raise Constraint_Error. Strictly, if we
-         --  take advantage of 11.6, these checks do not count as side effects.
-         --  However, we would prefer to consider that they are side effects,
-         --  since the backend CSE does not work very well on expressions which
-         --  can raise Constraint_Error. On the other hand if we don't consider
-         --  them to be side effect free, then we get some awkward expansions
-         --  in -gnato mode, resulting in code insertions at a point where we
-         --  do not have a clear model for performing the insertions.
-
-         --  Special handling for entity names
-
-         if Is_Entity_Name (N) then
-
-            --  Variables are considered to be a side effect if Variable_Ref
-            --  is set or if we have a volatile reference and Name_Req is off.
-            --  If Name_Req is True then we can't help returning a name which
-            --  effectively allows multiple references in any case.
-
-            if Is_Variable (N, Use_Original_Node => False) then
-               return not Variable_Ref
-                 and then (not Is_Volatile_Reference (N) or else Name_Req);
-
-            --  Any other entity (e.g. a subtype name) is definitely side
-            --  effect free.
-
-            else
-               return True;
-            end if;
-
-         --  A value known at compile time is always side effect free
-
-         elsif Compile_Time_Known_Value (N) then
-            return True;
-
-         --  A variable renaming is not side-effect free, because the renaming
-         --  will function like a macro in the front-end in some cases, and an
-         --  assignment can modify the component designated by N, so we need to
-         --  create a temporary for it.
-
-         --  The guard testing for Entity being present is needed at least in
-         --  the case of rewritten predicate expressions, and may well also be
-         --  appropriate elsewhere. Obviously we can't go testing the entity
-         --  field if it does not exist, so it's reasonable to say that this is
-         --  not the renaming case if it does not exist.
-
-         elsif Is_Entity_Name (Original_Node (N))
-           and then Present (Entity (Original_Node (N)))
-           and then Is_Renaming_Of_Object (Entity (Original_Node (N)))
-           and then Ekind (Entity (Original_Node (N))) /= E_Constant
-         then
-            declare
-               RO : constant Node_Id :=
-                      Renamed_Object (Entity (Original_Node (N)));
-
-            begin
-               --  If the renamed object is an indexed component, or an
-               --  explicit dereference, then the designated object could
-               --  be modified by an assignment.
-
-               if Nkind_In (RO, N_Indexed_Component,
-                                N_Explicit_Dereference)
-               then
-                  return False;
-
-               --  A selected component must have a safe prefix
-
-               elsif Nkind (RO) = N_Selected_Component then
-                  return Safe_Prefixed_Reference (RO);
-
-               --  In all other cases, designated object cannot be changed so
-               --  we are side effect free.
-
-               else
-                  return True;
-               end if;
-            end;
-
-         --  Remove_Side_Effects generates an object renaming declaration to
-         --  capture the expression of a class-wide expression. In VM targets
-         --  the frontend performs no expansion for dispatching calls to
-         --  class- wide types since they are handled by the VM. Hence, we must
-         --  locate here if this node corresponds to a previous invocation of
-         --  Remove_Side_Effects to avoid a never ending loop in the frontend.
-
-         elsif VM_Target /= No_VM
-            and then not Comes_From_Source (N)
-            and then Nkind (Parent (N)) = N_Object_Renaming_Declaration
-            and then Is_Class_Wide_Type (Etype (N))
-         then
-            return True;
-         end if;
-
-         --  For other than entity names and compile time known values,
-         --  check the node kind for special processing.
-
-         case Nkind (N) is
-
-            --  An attribute reference is side effect free if its expressions
-            --  are side effect free and its prefix is side effect free or
-            --  is an entity reference.
-
-            --  Is this right? what about x'first where x is a variable???
-
-            when N_Attribute_Reference =>
-               return Side_Effect_Free (Expressions (N))
-                 and then Attribute_Name (N) /= Name_Input
-                 and then (Is_Entity_Name (Prefix (N))
-                            or else Side_Effect_Free (Prefix (N)));
-
-            --  A binary operator is side effect free if and both operands are
-            --  side effect free. For this purpose binary operators include
-            --  membership tests and short circuit forms.
-
-            when N_Binary_Op | N_Membership_Test | N_Short_Circuit =>
-               return Side_Effect_Free (Left_Opnd  (N))
-                        and then
-                      Side_Effect_Free (Right_Opnd (N));
-
-            --  An explicit dereference is side effect free only if it is
-            --  a side effect free prefixed reference.
-
-            when N_Explicit_Dereference =>
-               return Safe_Prefixed_Reference (N);
-
-            --  An expression with action is side effect free if its expression
-            --  is side effect free and it has no actions.
-
-            when N_Expression_With_Actions =>
-               return Is_Empty_List (Actions (N))
-                        and then
-                      Side_Effect_Free (Expression (N));
-
-            --  A call to _rep_to_pos is side effect free, since we generate
-            --  this pure function call ourselves. Moreover it is critically
-            --  important to make this exception, since otherwise we can have
-            --  discriminants in array components which don't look side effect
-            --  free in the case of an array whose index type is an enumeration
-            --  type with an enumeration rep clause.
-
-            --  All other function calls are not side effect free
-
-            when N_Function_Call =>
-               return Nkind (Name (N)) = N_Identifier
-                 and then Is_TSS (Name (N), TSS_Rep_To_Pos)
-                 and then
-                   Side_Effect_Free (First (Parameter_Associations (N)));
-
-            --  An indexed component is side effect free if it is a side
-            --  effect free prefixed reference and all the indexing
-            --  expressions are side effect free.
-
-            when N_Indexed_Component =>
-               return Side_Effect_Free (Expressions (N))
-                 and then Safe_Prefixed_Reference (N);
-
-            --  A type qualification is side effect free if the expression
-            --  is side effect free.
-
-            when N_Qualified_Expression =>
-               return Side_Effect_Free (Expression (N));
-
-            --  A selected component is side effect free only if it is a side
-            --  effect free prefixed reference. If it designates a component
-            --  with a rep. clause it must be treated has having a potential
-            --  side effect, because it may be modified through a renaming, and
-            --  a subsequent use of the renaming as a macro will yield the
-            --  wrong value. This complex interaction between renaming and
-            --  removing side effects is a reminder that the latter has become
-            --  a headache to maintain, and that it should be removed in favor
-            --  of the gcc mechanism to capture values ???
-
-            when N_Selected_Component =>
-               if Nkind (Parent (N)) = N_Explicit_Dereference
-                 and then Has_Non_Standard_Rep (Designated_Type (Etype (N)))
-               then
-                  return False;
-               else
-                  return Safe_Prefixed_Reference (N);
-               end if;
-
-            --  A range is side effect free if the bounds are side effect free
-
-            when N_Range =>
-               return Side_Effect_Free (Low_Bound (N))
-                 and then Side_Effect_Free (High_Bound (N));
-
-            --  A slice is side effect free if it is a side effect free
-            --  prefixed reference and the bounds are side effect free.
-
-            when N_Slice =>
-               return Side_Effect_Free (Discrete_Range (N))
-                 and then Safe_Prefixed_Reference (N);
-
-            --  A type conversion is side effect free if the expression to be
-            --  converted is side effect free.
-
-            when N_Type_Conversion =>
-               return Side_Effect_Free (Expression (N));
-
-            --  A unary operator is side effect free if the operand
-            --  is side effect free.
-
-            when N_Unary_Op =>
-               return Side_Effect_Free (Right_Opnd (N));
-
-            --  An unchecked type conversion is side effect free only if it
-            --  is safe and its argument is side effect free.
-
-            when N_Unchecked_Type_Conversion =>
-               return Safe_Unchecked_Type_Conversion (N)
-                 and then Side_Effect_Free (Expression (N));
-
-            --  An unchecked expression is side effect free if its expression
-            --  is side effect free.
-
-            when N_Unchecked_Expression =>
-               return Side_Effect_Free (Expression (N));
-
-            --  A literal is side effect free
-
-            when N_Character_Literal    |
-                 N_Integer_Literal      |
-                 N_Real_Literal         |
-                 N_String_Literal       =>
-               return True;
-
-            --  We consider that anything else has side effects. This is a bit
-            --  crude, but we are pretty close for most common cases, and we
-            --  are certainly correct (i.e. we never return True when the
-            --  answer should be False).
-
-            when others =>
-               return False;
-         end case;
-      end Side_Effect_Free;
-
-      --  A list is side effect free if all elements of the list are side
-      --  effect free.
-
-      function Side_Effect_Free (L : List_Id) return Boolean is
-         N : Node_Id;
-
-      begin
-         if L = No_List or else L = Error_List then
-            return True;
-
-         else
-            N := First (L);
-            while Present (N) loop
-               if not Side_Effect_Free (N) then
-                  return False;
-               else
-                  Next (N);
-               end if;
-            end loop;
-
-            return True;
-         end if;
-      end Side_Effect_Free;
-
-      -------------------------
-      -- Within_In_Parameter --
-      -------------------------
-
-      function Within_In_Parameter (N : Node_Id) return Boolean is
-      begin
-         if not Comes_From_Source (N) then
-            return False;
-
-         elsif Is_Entity_Name (N) then
-            return Ekind (Entity (N)) = E_In_Parameter;
-
-         elsif Nkind_In (N, N_Indexed_Component, N_Selected_Component) then
-            return Within_In_Parameter (Prefix (N));
-
-         else
-            return False;
-         end if;
-      end Within_In_Parameter;
-
-   --  Start of processing for Remove_Side_Effects
-
    begin
       --  Handle cases in which there is nothing to do. In GNATprove mode,
       --  removal of side effects is useful for the light expansion of
@@ -7085,7 +6656,7 @@ package body Exp_Util is
 
       --  No action needed for side-effect free expressions
 
-      elsif Side_Effect_Free (Exp) then
+      elsif Side_Effect_Free (Exp, Name_Req, Variable_Ref) then
          return;
       end if;
 
@@ -7099,7 +6670,7 @@ package body Exp_Util is
       --  If it is a scalar type and we need to capture the value, just make
       --  a copy. Likewise for a function call, an attribute reference, a
       --  conditional expression, an allocator, or an operator. And if we have
-      --  a volatile reference and Name_Req is not set (see comments above for
+      --  a volatile reference and Name_Req is not set (see comments for
       --  Side_Effect_Free).
 
       if Is_Elementary_Type (Exp_Type)
@@ -7223,7 +6794,7 @@ package body Exp_Util is
       --  approach would generate an illegal access value (an access value
       --  cannot designate such an object - see Analyze_Reference). We skip
       --  using this scheme if we have an object of a volatile type and we do
-      --  not have Name_Req set true (see comments above for Side_Effect_Free).
+      --  not have Name_Req set true (see comments for Side_Effect_Free).
 
       --  In Ada 2012 a qualified expression is an object, but for purposes of
       --  removing side effects it still need to be transformed into a separate
@@ -8095,6 +7666,441 @@ package body Exp_Util is
       end if;
    end Set_Renamed_Subprogram;
 
+   ----------------------
+   -- Side_Effect_Free --
+   ----------------------
+
+   function Side_Effect_Free
+     (N            : Node_Id;
+      Name_Req     : Boolean := False;
+      Variable_Ref : Boolean := False) return Boolean
+   is
+      function Safe_Prefixed_Reference (N : Node_Id) return Boolean;
+      --  The argument N is a construct where the Prefix is dereferenced if it
+      --  is an access type and the result is a variable. The call returns True
+      --  if the construct is side effect free (not considering side effects in
+      --  other than the prefix which are to be tested by the caller).
+
+      function Within_In_Parameter (N : Node_Id) return Boolean;
+      --  Determines if N is a subcomponent of a composite in-parameter. If so,
+      --  N is not side-effect free when the actual is global and modifiable
+      --  indirectly from within a subprogram, because it may be passed by
+      --  reference. The front-end must be conservative here and assume that
+      --  this may happen with any array or record type. On the other hand, we
+      --  cannot create temporaries for all expressions for which this
+      --  condition is true, for various reasons that might require clearing up
+      --  ??? For example, discriminant references that appear out of place, or
+      --  spurious type errors with class-wide expressions. As a result, we
+      --  limit the transformation to loop bounds, which is so far the only
+      --  case that requires it.
+
+      -----------------------------
+      -- Safe_Prefixed_Reference --
+      -----------------------------
+
+      function Safe_Prefixed_Reference (N : Node_Id) return Boolean is
+      begin
+         --  If prefix is not side effect free, definitely not safe
+
+         if not Side_Effect_Free (Prefix (N), Name_Req, Variable_Ref) then
+            return False;
+
+         --  If the prefix is of an access type that is not access-to-constant,
+         --  then this construct is a variable reference, which means it is to
+         --  be considered to have side effects if Variable_Ref is set True.
+
+         elsif Is_Access_Type (Etype (Prefix (N)))
+           and then not Is_Access_Constant (Etype (Prefix (N)))
+           and then Variable_Ref
+         then
+            --  Exception is a prefix that is the result of a previous removal
+            --  of side-effects.
+
+            return Is_Entity_Name (Prefix (N))
+              and then not Comes_From_Source (Prefix (N))
+              and then Ekind (Entity (Prefix (N))) = E_Constant
+              and then Is_Internal_Name (Chars (Entity (Prefix (N))));
+
+         --  If the prefix is an explicit dereference then this construct is a
+         --  variable reference, which means it is to be considered to have
+         --  side effects if Variable_Ref is True.
+
+         --  We do NOT exclude dereferences of access-to-constant types because
+         --  we handle them as constant view of variables.
+
+         elsif Nkind (Prefix (N)) = N_Explicit_Dereference
+           and then Variable_Ref
+         then
+            return False;
+
+         --  Note: The following test is the simplest way of solving a complex
+         --  problem uncovered by the following test (Side effect on loop bound
+         --  that is a subcomponent of a global variable:
+
+         --    with Text_Io; use Text_Io;
+         --    procedure Tloop is
+         --      type X is
+         --        record
+         --          V : Natural := 4;
+         --          S : String (1..5) := (others => 'a');
+         --        end record;
+         --      X1 : X;
+
+         --      procedure Modi;
+
+         --      generic
+         --        with procedure Action;
+         --      procedure Loop_G (Arg : X; Msg : String)
+
+         --      procedure Loop_G (Arg : X; Msg : String) is
+         --      begin
+         --        Put_Line ("begin loop_g " & Msg & " will loop till: "
+         --                  & Natural'Image (Arg.V));
+         --        for Index in 1 .. Arg.V loop
+         --          Text_Io.Put_Line
+         --            (Natural'Image (Index) & " " & Arg.S (Index));
+         --          if Index > 2 then
+         --            Modi;
+         --          end if;
+         --        end loop;
+         --        Put_Line ("end loop_g " & Msg);
+         --      end;
+
+         --      procedure Loop1 is new Loop_G (Modi);
+         --      procedure Modi is
+         --      begin
+         --        X1.V := 1;
+         --        Loop1 (X1, "from modi");
+         --      end;
+         --
+         --    begin
+         --      Loop1 (X1, "initial");
+         --    end;
+
+         --  The output of the above program should be:
+
+         --    begin loop_g initial will loop till:  4
+         --     1 a
+         --     2 a
+         --     3 a
+         --    begin loop_g from modi will loop till:  1
+         --     1 a
+         --    end loop_g from modi
+         --     4 a
+         --    begin loop_g from modi will loop till:  1
+         --     1 a
+         --    end loop_g from modi
+         --    end loop_g initial
+
+         --  If a loop bound is a subcomponent of a global variable, a
+         --  modification of that variable within the loop may incorrectly
+         --  affect the execution of the loop.
+
+         elsif Nkind (Parent (Parent (N))) = N_Loop_Parameter_Specification
+           and then Within_In_Parameter (Prefix (N))
+           and then Variable_Ref
+         then
+            return False;
+
+         --  All other cases are side effect free
+
+         else
+            return True;
+         end if;
+      end Safe_Prefixed_Reference;
+
+      -------------------------
+      -- Within_In_Parameter --
+      -------------------------
+
+      function Within_In_Parameter (N : Node_Id) return Boolean is
+      begin
+         if not Comes_From_Source (N) then
+            return False;
+
+         elsif Is_Entity_Name (N) then
+            return Ekind (Entity (N)) = E_In_Parameter;
+
+         elsif Nkind_In (N, N_Indexed_Component, N_Selected_Component) then
+            return Within_In_Parameter (Prefix (N));
+
+         else
+            return False;
+         end if;
+      end Within_In_Parameter;
+
+   --  Start of processing for Side_Effect_Free
+
+   begin
+      --  Note on checks that could raise Constraint_Error. Strictly, if we
+      --  take advantage of 11.6, these checks do not count as side effects.
+      --  However, we would prefer to consider that they are side effects,
+      --  since the backend CSE does not work very well on expressions which
+      --  can raise Constraint_Error. On the other hand if we don't consider
+      --  them to be side effect free, then we get some awkward expansions
+      --  in -gnato mode, resulting in code insertions at a point where we
+      --  do not have a clear model for performing the insertions.
+
+      --  Special handling for entity names
+
+      if Is_Entity_Name (N) then
+
+         --  Variables are considered to be a side effect if Variable_Ref
+         --  is set or if we have a volatile reference and Name_Req is off.
+         --  If Name_Req is True then we can't help returning a name which
+         --  effectively allows multiple references in any case.
+
+         if Is_Variable (N, Use_Original_Node => False) then
+            return not Variable_Ref
+              and then (not Is_Volatile_Reference (N) or else Name_Req);
+
+         --  Any other entity (e.g. a subtype name) is definitely side
+         --  effect free.
+
+         else
+            return True;
+         end if;
+
+      --  A value known at compile time is always side effect free
+
+      elsif Compile_Time_Known_Value (N) then
+         return True;
+
+      --  A variable renaming is not side-effect free, because the renaming
+      --  will function like a macro in the front-end in some cases, and an
+      --  assignment can modify the component designated by N, so we need to
+      --  create a temporary for it.
+
+      --  The guard testing for Entity being present is needed at least in
+      --  the case of rewritten predicate expressions, and may well also be
+      --  appropriate elsewhere. Obviously we can't go testing the entity
+      --  field if it does not exist, so it's reasonable to say that this is
+      --  not the renaming case if it does not exist.
+
+      elsif Is_Entity_Name (Original_Node (N))
+        and then Present (Entity (Original_Node (N)))
+        and then Is_Renaming_Of_Object (Entity (Original_Node (N)))
+        and then Ekind (Entity (Original_Node (N))) /= E_Constant
+      then
+         declare
+            RO : constant Node_Id :=
+                   Renamed_Object (Entity (Original_Node (N)));
+
+         begin
+            --  If the renamed object is an indexed component, or an
+            --  explicit dereference, then the designated object could
+            --  be modified by an assignment.
+
+            if Nkind_In (RO, N_Indexed_Component,
+                             N_Explicit_Dereference)
+            then
+               return False;
+
+            --  A selected component must have a safe prefix
+
+            elsif Nkind (RO) = N_Selected_Component then
+               return Safe_Prefixed_Reference (RO);
+
+            --  In all other cases, designated object cannot be changed so
+            --  we are side effect free.
+
+            else
+               return True;
+            end if;
+         end;
+
+      --  Remove_Side_Effects generates an object renaming declaration to
+      --  capture the expression of a class-wide expression. In VM targets
+      --  the frontend performs no expansion for dispatching calls to
+      --  class- wide types since they are handled by the VM. Hence, we must
+      --  locate here if this node corresponds to a previous invocation of
+      --  Remove_Side_Effects to avoid a never ending loop in the frontend.
+
+      elsif VM_Target /= No_VM
+         and then not Comes_From_Source (N)
+         and then Nkind (Parent (N)) = N_Object_Renaming_Declaration
+         and then Is_Class_Wide_Type (Etype (N))
+      then
+         return True;
+      end if;
+
+      --  For other than entity names and compile time known values,
+      --  check the node kind for special processing.
+
+      case Nkind (N) is
+
+         --  An attribute reference is side effect free if its expressions
+         --  are side effect free and its prefix is side effect free or
+         --  is an entity reference.
+
+         --  Is this right? what about x'first where x is a variable???
+
+         when N_Attribute_Reference =>
+            return Side_Effect_Free (Expressions (N), Name_Req, Variable_Ref)
+              and then Attribute_Name (N) /= Name_Input
+              and then (Is_Entity_Name (Prefix (N))
+                         or else Side_Effect_Free
+                                   (Prefix (N), Name_Req, Variable_Ref));
+
+         --  A binary operator is side effect free if and both operands are
+         --  side effect free. For this purpose binary operators include
+         --  membership tests and short circuit forms.
+
+         when N_Binary_Op | N_Membership_Test | N_Short_Circuit =>
+            return Side_Effect_Free (Left_Opnd  (N), Name_Req, Variable_Ref)
+                     and then
+                   Side_Effect_Free (Right_Opnd (N), Name_Req, Variable_Ref);
+
+         --  An explicit dereference is side effect free only if it is
+         --  a side effect free prefixed reference.
+
+         when N_Explicit_Dereference =>
+            return Safe_Prefixed_Reference (N);
+
+         --  An expression with action is side effect free if its expression
+         --  is side effect free and it has no actions.
+
+         when N_Expression_With_Actions =>
+            return Is_Empty_List (Actions (N))
+              and then
+                Side_Effect_Free (Expression (N), Name_Req, Variable_Ref);
+
+         --  A call to _rep_to_pos is side effect free, since we generate
+         --  this pure function call ourselves. Moreover it is critically
+         --  important to make this exception, since otherwise we can have
+         --  discriminants in array components which don't look side effect
+         --  free in the case of an array whose index type is an enumeration
+         --  type with an enumeration rep clause.
+
+         --  All other function calls are not side effect free
+
+         when N_Function_Call =>
+            return Nkind (Name (N)) = N_Identifier
+              and then Is_TSS (Name (N), TSS_Rep_To_Pos)
+              and then
+                Side_Effect_Free
+                  (First (Parameter_Associations (N)), Name_Req, Variable_Ref);
+
+         --  An indexed component is side effect free if it is a side
+         --  effect free prefixed reference and all the indexing
+         --  expressions are side effect free.
+
+         when N_Indexed_Component =>
+            return Side_Effect_Free (Expressions (N), Name_Req, Variable_Ref)
+              and then Safe_Prefixed_Reference (N);
+
+         --  A type qualification is side effect free if the expression
+         --  is side effect free.
+
+         when N_Qualified_Expression =>
+            return Side_Effect_Free (Expression (N), Name_Req, Variable_Ref);
+
+         --  A selected component is side effect free only if it is a side
+         --  effect free prefixed reference. If it designates a component
+         --  with a rep. clause it must be treated has having a potential
+         --  side effect, because it may be modified through a renaming, and
+         --  a subsequent use of the renaming as a macro will yield the
+         --  wrong value. This complex interaction between renaming and
+         --  removing side effects is a reminder that the latter has become
+         --  a headache to maintain, and that it should be removed in favor
+         --  of the gcc mechanism to capture values ???
+
+         when N_Selected_Component =>
+            if Nkind (Parent (N)) = N_Explicit_Dereference
+              and then Has_Non_Standard_Rep (Designated_Type (Etype (N)))
+            then
+               return False;
+            else
+               return Safe_Prefixed_Reference (N);
+            end if;
+
+         --  A range is side effect free if the bounds are side effect free
+
+         when N_Range =>
+            return Side_Effect_Free (Low_Bound (N),  Name_Req, Variable_Ref)
+                      and then
+                   Side_Effect_Free (High_Bound (N), Name_Req, Variable_Ref);
+
+         --  A slice is side effect free if it is a side effect free
+         --  prefixed reference and the bounds are side effect free.
+
+         when N_Slice =>
+            return Side_Effect_Free
+                     (Discrete_Range (N), Name_Req, Variable_Ref)
+              and then Safe_Prefixed_Reference (N);
+
+         --  A type conversion is side effect free if the expression to be
+         --  converted is side effect free.
+
+         when N_Type_Conversion =>
+            return Side_Effect_Free (Expression (N), Name_Req, Variable_Ref);
+
+         --  A unary operator is side effect free if the operand
+         --  is side effect free.
+
+         when N_Unary_Op =>
+            return Side_Effect_Free (Right_Opnd (N), Name_Req, Variable_Ref);
+
+         --  An unchecked type conversion is side effect free only if it
+         --  is safe and its argument is side effect free.
+
+         when N_Unchecked_Type_Conversion =>
+            return Safe_Unchecked_Type_Conversion (N)
+              and then
+                Side_Effect_Free (Expression (N), Name_Req, Variable_Ref);
+
+         --  An unchecked expression is side effect free if its expression
+         --  is side effect free.
+
+         when N_Unchecked_Expression =>
+            return Side_Effect_Free (Expression (N), Name_Req, Variable_Ref);
+
+         --  A literal is side effect free
+
+         when N_Character_Literal    |
+              N_Integer_Literal      |
+              N_Real_Literal         |
+              N_String_Literal       =>
+            return True;
+
+         --  We consider that anything else has side effects. This is a bit
+         --  crude, but we are pretty close for most common cases, and we
+         --  are certainly correct (i.e. we never return True when the
+         --  answer should be False).
+
+         when others =>
+            return False;
+      end case;
+   end Side_Effect_Free;
+
+   --  A list is side effect free if all elements of the list are side
+   --  effect free.
+
+   function Side_Effect_Free
+     (L            : List_Id;
+      Name_Req     : Boolean := False;
+      Variable_Ref : Boolean := False) return Boolean
+   is
+      N : Node_Id;
+
+   begin
+      if L = No_List or else L = Error_List then
+         return True;
+
+      else
+         N := First (L);
+         while Present (N) loop
+            if not Side_Effect_Free (N, Name_Req, Variable_Ref) then
+               return False;
+            else
+               Next (N);
+            end if;
+         end loop;
+
+         return True;
+      end if;
+   end Side_Effect_Free;
+
    ----------------------------------
    -- Silly_Boolean_Array_Not_Test --
    ----------------------------------
diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index f14117c..40a6fbe 100644
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -770,14 +770,14 @@ package Exp_Util is
    --  Given the node for a subexpression, this function replaces the node if
    --  necessary by an equivalent subexpression that is guaranteed to be side
    --  effect free. This is done by extracting any actions that could cause
-   --  side effects, and inserting them using Insert_Actions into the tree to
-   --  which Exp is attached. Exp must be analyzed and resolved before the call
-   --  and is analyzed and resolved on return. The Name_Req may only be set to
+   --  side effects, and inserting them using Insert_Actions into the tree
+   --  to which Exp is attached. Exp must be analyzed and resolved before the
+   --  call and is analyzed and resolved on return. Name_Req may only be set to
    --  True if Exp has the form of a name, and the effect is to guarantee that
    --  any replacement maintains the form of name. If Variable_Ref is set to
    --  TRUE, a variable is considered as side effect (used in implementing
-   --  Force_Evaluation). Note: after call to Remove_Side_Effects, it is safe
-   --  to call New_Copy_Tree to obtain a copy of the resulting expression.
+   --  Force_Evaluation). Note: after call to Remove_Side_Effects, it is
+   --  safe to call New_Copy_Tree to obtain a copy of the resulting expression.
 
    function Represented_As_Scalar (T : Entity_Id) return Boolean;
    --  Returns True iff the implementation of this type in code generation
@@ -826,6 +826,29 @@ package Exp_Util is
    --  renamed subprogram. The node is rewritten to be an identifier that
    --  refers directly to the renamed subprogram, given by entity E.
 
+   function Side_Effect_Free
+     (N            : Node_Id;
+      Name_Req     : Boolean := False;
+      Variable_Ref : Boolean := False) return Boolean;
+   --  Determines if the tree N represents an expression that is known not
+   --  to have side effects. If this function returns True, then for example
+   --  a call to Remove_Side_Effects has no effect.
+   --
+   --  Name_Req controls the handling of volatile variable references. If
+   --  Name_Req is False (the normal case), then volatile references are
+   --  considered to be side effects. If Name_Req is True, then volatility
+   --  of variables is ignored.
+   --
+   --  If Variable_Ref is True, then all variable references are considered to
+   --  be side effects (regardless of volatility or the setting of Name_Req).
+
+   function Side_Effect_Free
+     (L            : List_Id;
+      Name_Req     : Boolean := False;
+      Variable_Ref : Boolean := False) return Boolean;
+   --  Determines if all elements of the list L are side effect free. Name_Req
+   --  and Variable_Ref are as described above.
+
    procedure Silly_Boolean_Array_Not_Test (N : Node_Id; T : Entity_Id);
    --  N is the node for a boolean array NOT operation, and T is the type of
    --  the array. This routine deals with the silly case where the subtype of
diff --git a/gcc/ada/par-ch13.adb b/gcc/ada/par-ch13.adb
index 4c661a5..fffa594 100644
--- a/gcc/ada/par-ch13.adb
+++ b/gcc/ada/par-ch13.adb
@@ -149,9 +149,9 @@ package body Ch13 is
    function Get_Aspect_Specifications
      (Semicolon : Boolean := True) return List_Id
    is
-      Aspects : List_Id;
-      Aspect  : Node_Id;
       A_Id    : Aspect_Id;
+      Aspect  : Node_Id;
+      Aspects : List_Id;
       OK      : Boolean;
 
    begin
@@ -173,9 +173,13 @@ package body Ch13 is
       loop
          OK := True;
 
+         --  The aspect mark is not an identifier
+
          if Token /= Tok_Identifier then
             Error_Msg_SC ("aspect identifier expected");
 
+            --  Skip the whole aspect specification list
+
             if Semicolon then
                Resync_Past_Semicolon;
             end if;
@@ -183,17 +187,16 @@ package body Ch13 is
             return Aspects;
          end if;
 
-         --  We have an identifier (which should be an aspect identifier)
-
          A_Id := Get_Aspect_Id (Token_Name);
          Aspect :=
            Make_Aspect_Specification (Token_Ptr,
              Identifier => Token_Node);
 
-         --  No valid aspect identifier present
+         --  The aspect mark is not recognized
 
          if A_Id = No_Aspect then
             Error_Msg_SC ("aspect identifier expected");
+            OK := False;
 
             --  Check bad spelling
 
@@ -209,17 +212,23 @@ package body Ch13 is
             Scan; -- past incorrect identifier
 
             if Token = Tok_Apostrophe then
-               Scan; -- past '
+               Scan; -- past apostrophe
                Scan; -- past presumably CLASS
             end if;
 
+            --  Attempt to parse the aspect definition by assuming it is an
+            --  expression.
+
             if Token = Tok_Arrow then
-               Scan; -- Past arrow
+               Scan; -- past arrow
                Set_Expression (Aspect, P_Expression);
-               OK := False;
+
+            --  The aspect may behave as a boolean aspect
 
             elsif Token = Tok_Comma then
-               OK := False;
+               null;
+
+            --  Otherwise the aspect contains a junk definition
 
             else
                if Semicolon then
@@ -229,7 +238,7 @@ package body Ch13 is
                return Aspects;
             end if;
 
-         --  OK aspect scanned
+         --  Aspect mark is OK
 
          else
             Scan; -- past identifier
@@ -237,60 +246,58 @@ package body Ch13 is
             --  Check for 'Class present
 
             if Token = Tok_Apostrophe then
-               if not Class_Aspect_OK (A_Id) then
-                  Error_Msg_Node_1 := Identifier (Aspect);
-                  Error_Msg_SC ("aspect& does not permit attribute here");
-                  Scan; -- past apostrophe
-                  Scan; -- past presumed CLASS
-                  OK := False;
-
-               else
+               if Class_Aspect_OK (A_Id) then
                   Scan; -- past apostrophe
 
-                  if Token /= Tok_Identifier
-                    or else Token_Name /= Name_Class
+                  if Token = Tok_Identifier
+                    and then Token_Name = Name_Class
                   then
+                     Scan; -- past CLASS
+                     Set_Class_Present (Aspect);
+                  else
                      Error_Msg_SC ("Class attribute expected here");
                      OK := False;
 
                      if Token = Tok_Identifier then
                         Scan; -- past identifier not CLASS
                      end if;
-
-                  else
-                     Scan; -- past CLASS
-                     Set_Class_Present (Aspect);
                   end if;
+
+               --  The aspect does not allow 'Class
+
+               else
+                  Error_Msg_Node_1 := Identifier (Aspect);
+                  Error_Msg_SC ("aspect& does not permit attribute here");
+                  OK := False;
+
+                  Scan; -- past apostrophe
+                  Scan; -- past presumably CLASS
                end if;
             end if;
 
-            --  Test case of missing aspect definition
+            --  Check for a missing aspect definition. Aspects with optional
+            --  definitions are not considered.
 
-            if Token = Tok_Comma
-              or else Token = Tok_Semicolon
-            then
+            if Token = Tok_Comma or else Token = Tok_Semicolon then
                if Aspect_Argument (A_Id) /= Optional_Expression
-                    and then
-                  Aspect_Argument (A_Id) /= Optional_Name
+                 and then Aspect_Argument (A_Id) /= Optional_Name
                then
                   Error_Msg_Node_1 := Identifier (Aspect);
                   Error_Msg_AP ("aspect& requires an aspect definition");
                   OK := False;
                end if;
 
+            --  Check for a missing arrow when the aspect has a definition
+
             elsif not Semicolon and then Token /= Tok_Arrow then
                if Aspect_Argument (A_Id) /= Optional_Expression
-                    and then
-                  Aspect_Argument (A_Id) /= Optional_Name
+                 and then Aspect_Argument (A_Id) /= Optional_Name
                then
-                  --  The name or expression may be there, but the arrow is
-                  --  missing. Skip to the end of the declaration.
-
                   T_Arrow;
                   Resync_To_Semicolon;
                end if;
 
-            --  Here we have an aspect definition
+            --  Otherwise we have an aspect definition
 
             else
                if Token = Tok_Arrow then
@@ -300,9 +307,107 @@ package body Ch13 is
                   OK := False;
                end if;
 
+               --  Detect a common error where the non-null definition of
+               --  aspect Depends, Global, Refined_Depends or Refined_Global
+               --  must be enclosed in parentheses.
+
+               if Token /= Tok_Left_Paren and then Token /= Tok_Null then
+
+                  --  [Refined_]Depends
+
+                  if A_Id = Aspect_Depends
+                       or else
+                     A_Id = Aspect_Refined_Depends
+                  then
+                     Error_Msg_SC -- CODEFIX
+                       ("missing ""(""");
+                     Resync_Past_Malformed_Aspect;
+
+                     --  Return when the current aspect is the last in the list
+                     --  of specifications and the list applies to a body.
+
+                     if Token = Tok_Is then
+                        return Aspects;
+                     end if;
+
+                  --  [Refined_]Global
+
+                  elsif A_Id = Aspect_Global
+                          or else
+                        A_Id = Aspect_Refined_Global
+                  then
+                     declare
+                        Scan_State : Saved_Scan_State;
+
+                     begin
+                        Save_Scan_State (Scan_State);
+                        Scan; -- past item or mode_selector
+
+                        --  Emit an error when the aspect has a mode_selector
+                        --  as the moded_global_list must be parenthesized:
+                        --    with Global => Output => Item
+
+                        if Token = Tok_Arrow then
+                           Restore_Scan_State (Scan_State);
+                           Error_Msg_SC -- CODEFIX
+                             ("missing ""(""");
+                           Resync_Past_Malformed_Aspect;
+
+                           --  Return when the current aspect is the last in
+                           --  the list of specifications and the list applies
+                           --  to a body.
+
+                           if Token = Tok_Is then
+                              return Aspects;
+                           end if;
+
+                        elsif Token = Tok_Comma then
+                           Scan; -- past comma
+
+                           --  An item followed by a comma does not need to
+                           --  be parenthesized if the next token is a valid
+                           --  aspect name:
+                           --    with Global => Item,
+                           --         Aspect => ...
+
+                           if Token = Tok_Identifier
+                             and then Get_Aspect_Id (Token_Name) /= No_Aspect
+                           then
+                              Restore_Scan_State (Scan_State);
+
+                           --  Otherwise this is a list of items in which case
+                           --  the list must be parenthesized.
+
+                           else
+                              Restore_Scan_State (Scan_State);
+                              Error_Msg_SC -- CODEFIX
+                                ("missing ""(""");
+                              Resync_Past_Malformed_Aspect;
+
+                              --  Return when the current aspect is the last
+                              --  in the list of specifications and the list
+                              --  applies to a body.
+
+                              if Token = Tok_Is then
+                                 return Aspects;
+                              end if;
+                           end if;
+
+                        --  The definition of [Refined_]Global does not need to
+                        --  be parenthesized.
+
+                        else
+                           Restore_Scan_State (Scan_State);
+                        end if;
+                     end;
+                  end if;
+               end if;
+
+               --  Parse the aspect definition depening on the expected
+               --  argument kind.
+
                if Aspect_Argument (A_Id) = Name
-                    or else
-                  Aspect_Argument (A_Id) = Optional_Name
+                 or else Aspect_Argument (A_Id) = Optional_Name
                then
                   Set_Expression (Aspect, P_Name);
 
@@ -315,18 +420,21 @@ package body Ch13 is
                end if;
             end if;
 
-            --  If OK clause scanned, add it to the list
+            --  Add the aspect to the resulting list only when it was properly
+            --  parsed.
 
             if OK then
                Append (Aspect, Aspects);
             end if;
 
+            --  The aspect specification list contains more than one aspect
+
             if Token = Tok_Comma then
                Scan; -- past comma
                goto Continue;
 
-            --  Recognize the case where a comma is missing between two
-            --  aspects, issue an error and proceed with next aspect.
+            --  Check for a missing comma between two aspects. Emit an error
+            --  and proceed to the next aspect.
 
             elsif Token = Tok_Identifier
               and then Get_Aspect_Id (Token_Name) /= No_Aspect
@@ -338,20 +446,25 @@ package body Ch13 is
                   Save_Scan_State (Scan_State);
                   Scan; -- past identifier
 
-                  if Token = Tok_Arrow then
+                  --  Attempt to detect ' or => following a potential aspect
+                  --  mark.
+
+                  if Token = Tok_Apostrophe or else Token = Tok_Arrow then
                      Restore_Scan_State (Scan_State);
                      Error_Msg_AP -- CODEFIX
                        ("|missing "",""");
                      goto Continue;
 
+                  --  The construct following the current aspect is not an
+                  --  aspect.
+
                   else
                      Restore_Scan_State (Scan_State);
                   end if;
                end;
 
-            --  Recognize the case where a semicolon was mistyped for a comma
-            --  between two aspects, issue an error and proceed with next
-            --  aspect.
+            --  Check for a mistyped semicolon in place of a comma between two
+            --  aspects. Emit an error and proceed to the next aspect.
 
             elsif Token = Tok_Semicolon then
                declare
@@ -366,20 +479,22 @@ package body Ch13 is
                   then
                      Scan; -- past identifier
 
-                     if Token = Tok_Arrow then
+                     --  Attempt to detect ' or => following a potential aspect
+                     --  mark.
+
+                     if Token = Tok_Apostrophe or else Token = Tok_Arrow then
                         Restore_Scan_State (Scan_State);
                         Error_Msg_SC -- CODEFIX
                           ("|"";"" should be "",""");
                         Scan; -- past semicolon
                         goto Continue;
-
-                     else
-                        Restore_Scan_State (Scan_State);
                      end if;
-
-                  else
-                     Restore_Scan_State (Scan_State);
                   end if;
+
+                  --  The construct following the current aspect is not an
+                  --  aspect.
+
+                  Restore_Scan_State (Scan_State);
                end;
             end if;
 
@@ -397,7 +512,6 @@ package body Ch13 is
       end loop;
 
       return Aspects;
-
    end Get_Aspect_Specifications;
 
    --------------------------------------------
diff --git a/gcc/ada/par-sync.adb b/gcc/ada/par-sync.adb
index 0cf73db..83987da 100644
--- a/gcc/ada/par-sync.adb
+++ b/gcc/ada/par-sync.adb
@@ -148,47 +148,75 @@ package body Sync is
       end if;
    end Resync_Init;
 
-   ---------------------------
-   -- Resync_Past_Semicolon --
-   ---------------------------
+   ----------------------------------
+   -- Resync_Past_Malformed_Aspect --
+   ----------------------------------
 
-   procedure Resync_Past_Semicolon is
+   procedure Resync_Past_Malformed_Aspect is
    begin
       Resync_Init;
 
       loop
-         --  Done if we are at a semicolon
+         --  A comma may separate two aspect specifications, but it may also
+         --  delimit multiple arguments of a single aspect.
 
-         if Token = Tok_Semicolon then
-            Scan; -- past semicolon
+         if Token = Tok_Comma then
+            declare
+               Scan_State : Saved_Scan_State;
+
+            begin
+               Save_Scan_State (Scan_State);
+               Scan; -- past comma
+
+               --  The identifier following the comma is a valid aspect, the
+               --  current malformed aspect has been successfully skipped.
+
+               if Token = Tok_Identifier
+                 and then Get_Aspect_Id (Token_Name) /= No_Aspect
+               then
+                  Restore_Scan_State (Scan_State);
+                  exit;
+
+               --  The comma is delimiting multiple arguments of an aspect
+
+               else
+                  Restore_Scan_State (Scan_State);
+               end if;
+            end;
+
+         --  An IS signals the last aspect specification when the related
+         --  context is a body.
+
+         elsif Token = Tok_Is then
             exit;
 
-         --  Done if we are at a token which normally appears only after
-         --  a semicolon. One special glitch is that the keyword private is
-         --  in this category only if it does NOT appear after WITH.
+         --  A semicolon signals the last aspect specification
 
-         elsif Token in Token_Class_After_SM
-            and then (Token /= Tok_Private or else Prev_Token /= Tok_With)
-         then
+         elsif Token = Tok_Semicolon then
             exit;
 
-         --  Otherwise keep going
+         --  In the case of a mistyped semicolon, any token which follows a
+         --  semicolon signals the last aspect specification.
 
-         else
-            Scan;
+         elsif Token in Token_Class_After_SM then
+            exit;
          end if;
+
+         --  Keep on resyncing
+
+         Scan;
       end loop;
 
       --  Fall out of loop with resynchronization complete
 
       Resync_Resume;
-   end Resync_Past_Semicolon;
+   end Resync_Past_Malformed_Aspect;
 
-   -------------------------
-   -- Resync_To_Semicolon --
-   -------------------------
+   ---------------------------
+   -- Resync_Past_Semicolon --
+   ---------------------------
 
-   procedure Resync_To_Semicolon is
+   procedure Resync_Past_Semicolon is
    begin
       Resync_Init;
 
@@ -196,6 +224,7 @@ package body Sync is
          --  Done if we are at a semicolon
 
          if Token = Tok_Semicolon then
+            Scan; -- past semicolon
             exit;
 
          --  Done if we are at a token which normally appears only after
@@ -217,7 +246,7 @@ package body Sync is
       --  Fall out of loop with resynchronization complete
 
       Resync_Resume;
-   end Resync_To_Semicolon;
+   end Resync_Past_Semicolon;
 
    ----------------------------------------------
    -- Resync_Past_Semicolon_Or_To_Loop_Or_Then --
@@ -275,35 +304,6 @@ package body Sync is
       end if;
    end Resync_Resume;
 
-   --------------------
-   -- Resync_To_When --
-   --------------------
-
-   procedure Resync_To_When is
-   begin
-      Resync_Init;
-
-      loop
-         --  Done if at semicolon, WHEN or IS
-
-         if Token = Tok_Semicolon
-           or else Token = Tok_When
-           or else Token = Tok_Is
-         then
-            exit;
-
-         --  Otherwise keep going
-
-         else
-            Scan;
-         end if;
-      end loop;
-
-      --  Fall out of loop with resynchronization complete
-
-      Resync_Resume;
-   end Resync_To_When;
-
    ---------------------------
    -- Resync_Semicolon_List --
    ---------------------------
@@ -340,4 +340,68 @@ package body Sync is
       Resync_Resume;
    end Resync_Semicolon_List;
 
+   -------------------------
+   -- Resync_To_Semicolon --
+   -------------------------
+
+   procedure Resync_To_Semicolon is
+   begin
+      Resync_Init;
+
+      loop
+         --  Done if we are at a semicolon
+
+         if Token = Tok_Semicolon then
+            exit;
+
+         --  Done if we are at a token which normally appears only after
+         --  a semicolon. One special glitch is that the keyword private is
+         --  in this category only if it does NOT appear after WITH.
+
+         elsif Token in Token_Class_After_SM
+           and then (Token /= Tok_Private or else Prev_Token /= Tok_With)
+         then
+            exit;
+
+         --  Otherwise keep going
+
+         else
+            Scan;
+         end if;
+      end loop;
+
+      --  Fall out of loop with resynchronization complete
+
+      Resync_Resume;
+   end Resync_To_Semicolon;
+
+   --------------------
+   -- Resync_To_When --
+   --------------------
+
+   procedure Resync_To_When is
+   begin
+      Resync_Init;
+
+      loop
+         --  Done if at semicolon, WHEN or IS
+
+         if Token = Tok_Semicolon
+           or else Token = Tok_When
+           or else Token = Tok_Is
+         then
+            exit;
+
+         --  Otherwise keep going
+
+         else
+            Scan;
+         end if;
+      end loop;
+
+      --  Fall out of loop with resynchronization complete
+
+      Resync_Resume;
+   end Resync_To_When;
+
 end Sync;
diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb
index 93f5bb5..7de8458 100644
--- a/gcc/ada/par.adb
+++ b/gcc/ada/par.adb
@@ -1079,6 +1079,10 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
       --  advanced to the next vertical bar, arrow, or semicolon, whichever
       --  comes first. We also quit if we encounter an end of file.
 
+      procedure Resync_Cunit;
+      --  Synchronize to next token which could be the start of a compilation
+      --  unit, or to the end of file token.
+
       procedure Resync_Expression;
       --  Used if an error is detected during the parsing of an expression.
       --  It skips past tokens until either a token which cannot be part of
@@ -1087,6 +1091,11 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
       --  current parenthesis level (a parenthesis level counter is maintained
       --  to carry out this test).
 
+      procedure Resync_Past_Malformed_Aspect;
+      --  Used when parsing aspect specifications to skip a malformed aspect.
+      --  The scan pointer is positioned next to a comma, a semicolon or "is"
+      --  when the aspect applies to a body.
+
       procedure Resync_Past_Semicolon;
       --  Used if an error occurs while scanning a sequence of declarations.
       --  The scan pointer is positioned past the next semicolon and the scan
@@ -1094,30 +1103,26 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
       --  starts a declaration (but we make sure to skip at least one token
       --  in this case, to avoid getting stuck in a loop).
 
-      procedure Resync_To_Semicolon;
-      --  Similar to Resync_Past_Semicolon, except that the scan pointer is
-      --  left pointing to the semicolon rather than past it.
-
       procedure Resync_Past_Semicolon_Or_To_Loop_Or_Then;
       --  Used if an error occurs while scanning a sequence of statements. The
       --  scan pointer is positioned past the next semicolon, or to the next
       --  occurrence of either then or loop, and the scan resumes.
 
-      procedure Resync_To_When;
-      --  Used when an error occurs scanning an entry index specification. The
-      --  scan pointer is positioned to the next WHEN (or to IS or semicolon if
-      --  either of these appear before WHEN, indicating another error has
-      --  occurred).
-
       procedure Resync_Semicolon_List;
       --  Used if an error occurs while scanning a parenthesized list of items
       --  separated by semicolons. The scan pointer is advanced to the next
       --  semicolon or right parenthesis at the outer parenthesis level, or
       --  to the next is or RETURN keyword occurrence, whichever comes first.
 
-      procedure Resync_Cunit;
-      --  Synchronize to next token which could be the start of a compilation
-      --  unit, or to the end of file token.
+      procedure Resync_To_Semicolon;
+      --  Similar to Resync_Past_Semicolon, except that the scan pointer is
+      --  left pointing to the semicolon rather than past it.
+
+      procedure Resync_To_When;
+      --  Used when an error occurs scanning an entry index specification. The
+      --  scan pointer is positioned to the next WHEN (or to IS or semicolon if
+      --  either of these appear before WHEN, indicating another error has
+      --  occurred).
    end Sync;
 
    --------------
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index cb8b0ee..af476c0 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -649,9 +649,8 @@ package Sinfo is
    --    Mod for signed integer types is expanded into equivalent expressions
    --    using Rem (which is % in C) and other C-available operators.
 
-   --    The Actions list of an Expression_With_Actions node has any object
-   --    declarations removed, so that it is composed only of expressions
-   --    (so that DO X,... Y IN Z can be represented as (X, .. Y, Z) in C).
+   --    The Actions list of an Expression_With_Actions node does not contain
+   --    any declarations,(so that DO X, .. Y IN Z becomes (X, .. Y, Z) in C).
 
    ------------------------------------
    -- Description of Semantic Fields --
@@ -7426,11 +7425,8 @@ package Sinfo is
       --  not a proper expression), and in the long term all cases of this
       --  idiom should instead use a new node kind N_Compound_Statement.
 
-      --  Note: In Modify_Tree_For_C, we eliminate declarations from the list
-      --  of actions, inserting them at the outer level. If we move an object
-      --  declaration with an initialization expression in this manner, then
-      --  the action is replaced by an appropriate assignment, otherwise it is
-      --  removed from the list of actions.
+      --  Note: In Modify_Tree_For_C, we never generate any declarations in
+      --  the action list, which can contain only non-declarative statements.
 
       --------------------
       -- Free Statement --