[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

gcc/ada/ChangeLog

 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.
 

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;
 

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.

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

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

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;

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;
 
    --------------

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 --