[multiple changes]

2013-01-04  Thomas Quinot  <quinot@adacore.com>

	* sinfo.ads: Minor documentation update.

2013-01-04  Thomas Quinot  <quinot@adacore.com>

	* sem_ch3.adb, einfo.adb (Analyze_Object_Declaration): Do not set Ekind
	before resolving initialization expression.

2013-01-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* checks.adb (Generate_Index_Checks): Delay the generation of
	the check for an indexed component where the prefix mentions
	Loop_Entry until the attribute has been properly expanded.
	* exp_ch5.adb (Expand_Loop_Entry_Attributes): Perform minor
	decoration of the constant that captures the value of Loop_Entry's
	prefix at the entry point into a loop.	Generate index checks
	for an attribute reference that has been transformed into an
	indexed component.

2013-01-04  Thomas Quinot  <quinot@adacore.com>

	* exp_prag.adb, exp_util.adb, exp_util.ads, freeze.adb, exp_aggr.adb,
	sem_ch13.adb (Exp_Aggr.Collect_Initialization_Statements): Nothing to
	do if Obj is already frozen.
	(Exp_Util.Find_Init_Call): Rename to...
	(Exp_Util.Remove_Init_Call): New subprogram, renamed from
	Find_Init_Call.  Remove the initialization call from the enclosing
	list if found, and if it is from an Initialization_Statements
	attribute, reset it.
	(Exp_Util.Append_Freeze_Action): Minor code reorganization.
	(Exp_Util.Append_Freeze_Actions): Ensure a freeze node has been
	allocated (as is already done in Append_Freeze_Action).
	(Freeze.Freeze_Entity): For an object with captured
	Initialization_Statements and non-delayed freezeing, unwrap the
	initialization statements and insert and them directly in the
	enclosing list.
	(Sem_Ch13.Check_Address_Clause): For an object
	with Initialization_Statements and an address clause, unwrap the
	initialization statements when moving them to the freeze actions.

From-SVN: r194887

gcc/ada/ChangeLog

+2013-01-04  Thomas Quinot  <quinot@adacore.com>
+
+	* sinfo.ads: Minor documentation update.
+
+2013-01-04  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_ch3.adb, einfo.adb (Analyze_Object_Declaration): Do not set Ekind
+	before resolving initialization expression.
+
+2013-01-04  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* checks.adb (Generate_Index_Checks): Delay the generation of
+	the check for an indexed component where the prefix mentions
+	Loop_Entry until the attribute has been properly expanded.
+	* exp_ch5.adb (Expand_Loop_Entry_Attributes): Perform minor
+	decoration of the constant that captures the value of Loop_Entry's
+	prefix at the entry point into a loop.	Generate index checks
+	for an attribute reference that has been transformed into an
+	indexed component.
+
+2013-01-04  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_prag.adb, exp_util.adb, exp_util.ads, freeze.adb, exp_aggr.adb,
+	sem_ch13.adb (Exp_Aggr.Collect_Initialization_Statements): Nothing to
+	do if Obj is already frozen.
+	(Exp_Util.Find_Init_Call): Rename to...
+	(Exp_Util.Remove_Init_Call): New subprogram, renamed from
+	Find_Init_Call.  Remove the initialization call from the enclosing
+	list if found, and if it is from an Initialization_Statements
+	attribute, reset it.
+	(Exp_Util.Append_Freeze_Action): Minor code reorganization.
+	(Exp_Util.Append_Freeze_Actions): Ensure a freeze node has been
+	allocated (as is already done in Append_Freeze_Action).
+	(Freeze.Freeze_Entity): For an object with captured
+	Initialization_Statements and non-delayed freezeing, unwrap the
+	initialization statements and insert and them directly in the
+	enclosing list.
+	(Sem_Ch13.Check_Address_Clause): For an object
+	with Initialization_Statements and an address clause, unwrap the
+	initialization statements when moving them to the freeze actions.
+
 2013-01-03  Pascal Obry  <obry@adacore.com>
 
 	* prj-attr.adb, projects.texi, snames.ads-tmpl: Add package remote and

gcc/ada/checks.adb

@@ -5522,6 +5522,23 @@ package body Checks is
         or else Index_Checks_Suppressed (Etype (A))
       then
          return;
+
+      --  The indexed component we are dealing with contains 'Loop_Entry in its
+      --  prefix. This case arises when analysis has determined that constructs
+      --  such as
+
+      --     Prefix'Loop_Entry (Expr)
+      --     Prefix'Loop_Entry (Expr1, Expr2, ... ExprN)
+
+      --  require rewriting for error detection purposes. A side effect of this
+      --  action is the generation of index checks that mention 'Loop_Entry.
+      --  Delay the generation of the check until 'Loop_Entry has been properly
+      --  expanded. This is done in Expand_Loop_Entry_Attributes.
+
+      elsif Nkind (Prefix (N)) = N_Attribute_Reference
+        and then Attribute_Name (Prefix (N)) = Name_Loop_Entry
+      then
+         return;
       end if;
 
       --  Generate a raise of constraint error with the appropriate reason and

gcc/ada/einfo.adb

@@ -4263,7 +4263,11 @@ package body Einfo is
 
    procedure Set_Initialization_Statements (Id : E; V : N) is
    begin
-      pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
+      --  Tolerate an E_Void entity since this can be called while resolving
+      --  an aggregate used as the initialization expression for an object
+      --  declaration, and this occurs before the Ekind for the object is set.
+
+      pragma Assert (Ekind_In (Id, E_Void, E_Constant, E_Variable));
       Set_Node28 (Id, V);
    end Set_Initialization_Statements;
 

gcc/ada/exp_aggr.adb

@@ -106,9 +106,10 @@ package body Exp_Aggr is
      (Obj        : Entity_Id;
       N          : Node_Id;
       Node_After : Node_Id);
-   --  Collect actions inserted after N until, but not including, Node_After,
-   --  for initialization of Obj, and move them to an expression with actions,
-   --  which becomes the Initialization_Statements for Obj.
+   --  If Obj is not frozen, collect actions inserted after N until, but not
+   --  including, Node_After, for initialization of Obj, and move them to an
+   --  expression with actions, which becomes the Initialization_Statements for
+   --  Obj.
 
    ------------------------------------------------------
    -- Local subprograms for Record Aggregate Expansion --
@@ -2965,6 +2966,13 @@ package body Exp_Aggr is
       EA           : Node_Id;
       Init_Actions : constant List_Id := New_List;
    begin
+      --  Nothing to do if Obj is already frozen, as in this case we known we
+      --  won't need to move the initialization statements about later on.
+
+      if Is_Frozen (Obj) then
+         return;
+      end if;
+
       Init_Node := N;
 
       while Next (Init_Node) /= Node_After loop

gcc/ada/exp_ch5.adb

@@ -1828,11 +1828,29 @@ package body Exp_Ch5 is
              Object_Definition   => New_Reference_To (Typ, Loc),
              Expression          => Relocate_Node (Prefix (LE))));
 
+         --  Perform minor decoration as this information will be needed for
+         --  the creation of index checks (if applicable).
+
+         Set_Ekind (Temp, E_Constant);
+         Set_Etype (Temp, Typ);
+
          --  Replace the original attribute with a reference to the constant
 
          Rewrite (LE, New_Reference_To (Temp, Loc));
          Set_Etype (LE, Typ);
 
+         --  Analysis converts attribute references of the following form
+
+         --     Prefix'Loop_Entry (Expr)
+         --     Prefix'Loop_Entry (Expr1, Expr2, ... ExprN)
+
+         --  into indexed components for error detection purposes. Generate
+         --  index checks now that 'Loop_Entry has been properly expanded.
+
+         if Nkind (Parent (LE)) = N_Indexed_Component then
+            Generate_Index_Checks (Parent (LE));
+         end if;
+
          Next_Elmt (LE_Elmt);
       end loop;
 

gcc/ada/exp_prag.adb

@@ -549,12 +549,9 @@ package body Exp_Prag is
       Def_Id := Entity (Arg2 (N));
       if Ekind (Def_Id) = E_Variable then
 
-         --  Find generated initialization call for object, if any
+         --  Find and remove generated initialization call for object, if any
 
-         Init_Call := Find_Init_Call (Def_Id, Rep_Clause => N);
-         if Present (Init_Call) then
-            Remove (Init_Call);
-         end if;
+         Init_Call := Remove_Init_Call (Def_Id, Rep_Clause => N);
 
          --  Any default initialization expression should be removed
          --  (e.g., null defaults for access objects, zero initialization

gcc/ada/exp_util.adb

@@ -366,10 +366,11 @@ package body Exp_Util is
       Fnode := Freeze_Node (T);
 
       if No (Actions (Fnode)) then
-         Set_Actions (Fnode, New_List);
+         Set_Actions (Fnode, New_List (N));
+      else
+         Append (N, Actions (Fnode));
       end if;
 
-      Append (N, Actions (Fnode));
    end Append_Freeze_Action;
 
    ---------------------------
@@ -377,18 +378,20 @@ package body Exp_Util is
    ---------------------------
 
    procedure Append_Freeze_Actions (T : Entity_Id; L : List_Id) is
-      Fnode : constant Node_Id := Freeze_Node (T);
+      Fnode : Node_Id;
 
    begin
       if No (L) then
          return;
+      end if;
+
+      Ensure_Freeze_Node (T);
+      Fnode := Freeze_Node (T);
 
+      if No (Actions (Fnode)) then
+         Set_Actions (Fnode, L);
       else
-         if No (Actions (Fnode)) then
-            Set_Actions (Fnode, L);
-         else
-            Append_List (L, Actions (Fnode));
-         end if;
+         Append_List (L, Actions (Fnode));
       end if;
    end Append_Freeze_Actions;
 
@@ -2160,101 +2163,6 @@ package body Exp_Util is
       end if;
    end Expand_Subtype_From_Expr;
 
-   --------------------
-   -- Find_Init_Call --
-   --------------------
-
-   function Find_Init_Call
-     (Var        : Entity_Id;
-      Rep_Clause : Node_Id) return Node_Id
-   is
-      Par : constant Node_Id   := Parent (Var);
-      Typ : constant Entity_Id := Etype (Var);
-
-      Init_Proc : Entity_Id;
-      --  Initialization procedure for Typ
-
-      function Find_Init_Call_In_List (From : Node_Id) return Node_Id;
-      --  Look for init call for Var starting at From and scanning the
-      --  enclosing list until Rep_Clause or the end of the list is reached.
-
-      ----------------------------
-      -- Find_Init_Call_In_List --
-      ----------------------------
-
-      function Find_Init_Call_In_List (From : Node_Id) return Node_Id is
-         Init_Call : Node_Id;
-      begin
-         Init_Call := From;
-
-         while Present (Init_Call) and then Init_Call /= Rep_Clause loop
-            if Nkind (Init_Call) = N_Procedure_Call_Statement
-              and then Is_Entity_Name (Name (Init_Call))
-              and then Entity (Name (Init_Call)) = Init_Proc
-            then
-               return Init_Call;
-            end if;
-
-            Next (Init_Call);
-         end loop;
-
-         return Empty;
-      end Find_Init_Call_In_List;
-
-      Init_Call : Node_Id;
-
-   --  Start of processing for Find_Init_Call
-
-   begin
-      if Present (Initialization_Statements (Var)) then
-         return Initialization_Statements (Var);
-
-      elsif not Has_Non_Null_Base_Init_Proc (Typ) then
-
-         --  No init proc for the type, so obviously no call to be found
-
-         return Empty;
-      end if;
-
-      --  We might be able to handle other cases below by just properly setting
-      --  Initialization_Statements at the point where the init proc call is
-      --  generated???
-
-      Init_Proc := Base_Init_Proc (Typ);
-
-      --  First scan the list containing the declaration of Var
-
-      Init_Call := Find_Init_Call_In_List (From => Next (Par));
-
-      --  If not found, also look on Var's freeze actions list, if any, since
-      --  the init call may have been moved there (case of an address clause
-      --  applying to Var).
-
-      if No (Init_Call) and then Present (Freeze_Node (Var)) then
-         Init_Call :=
-           Find_Init_Call_In_List (First (Actions (Freeze_Node (Var))));
-      end if;
-
-      --  If the initialization call has actuals that use the secondary stack,
-      --  the call may have been wrapped into a temporary block, in which case
-      --  the block itself has to be removed.
-
-      if No (Init_Call) and then Nkind (Next (Par)) = N_Block_Statement then
-         declare
-            Blk : constant Node_Id := Next (Par);
-         begin
-            if Present
-                 (Find_Init_Call_In_List
-                   (First (Statements (Handled_Statement_Sequence (Blk)))))
-            then
-               Init_Call := Blk;
-            end if;
-         end;
-      end if;
-
-      return Init_Call;
-   end Find_Init_Call;
-
    ------------------------
    -- Find_Interface_ADT --
    ------------------------
@@ -6295,6 +6203,106 @@ package body Exp_Util is
       end case;
    end Process_Statements_For_Controlled_Objects;
 
+   ----------------------
+   -- Remove_Init_Call --
+   ----------------------
+
+   function Remove_Init_Call
+     (Var        : Entity_Id;
+      Rep_Clause : Node_Id) return Node_Id
+   is
+      Par : constant Node_Id   := Parent (Var);
+      Typ : constant Entity_Id := Etype (Var);
+
+      Init_Proc : Entity_Id;
+      --  Initialization procedure for Typ
+
+      function Find_Init_Call_In_List (From : Node_Id) return Node_Id;
+      --  Look for init call for Var starting at From and scanning the
+      --  enclosing list until Rep_Clause or the end of the list is reached.
+
+      ----------------------------
+      -- Find_Init_Call_In_List --
+      ----------------------------
+
+      function Find_Init_Call_In_List (From : Node_Id) return Node_Id is
+         Init_Call : Node_Id;
+      begin
+         Init_Call := From;
+
+         while Present (Init_Call) and then Init_Call /= Rep_Clause loop
+            if Nkind (Init_Call) = N_Procedure_Call_Statement
+              and then Is_Entity_Name (Name (Init_Call))
+              and then Entity (Name (Init_Call)) = Init_Proc
+            then
+               return Init_Call;
+            end if;
+
+            Next (Init_Call);
+         end loop;
+
+         return Empty;
+      end Find_Init_Call_In_List;
+
+      Init_Call : Node_Id;
+
+   --  Start of processing for Find_Init_Call
+
+   begin
+      if Present (Initialization_Statements (Var)) then
+         Init_Call := Initialization_Statements (Var);
+         Set_Initialization_Statements (Var, Empty);
+
+      elsif not Has_Non_Null_Base_Init_Proc (Typ) then
+
+         --  No init proc for the type, so obviously no call to be found
+
+         return Empty;
+
+      else
+         --  We might be able to handle other cases below by just properly
+         --  setting Initialization_Statements at the point where the init proc
+         --  call is generated???
+
+         Init_Proc := Base_Init_Proc (Typ);
+
+         --  First scan the list containing the declaration of Var
+
+         Init_Call := Find_Init_Call_In_List (From => Next (Par));
+
+         --  If not found, also look on Var's freeze actions list, if any,
+         --  since the init call may have been moved there (case of an address
+         --  clause applying to Var).
+
+         if No (Init_Call) and then Present (Freeze_Node (Var)) then
+            Init_Call :=
+              Find_Init_Call_In_List (First (Actions (Freeze_Node (Var))));
+         end if;
+
+         --  If the initialization call has actuals that use the secondary
+         --  stack, the call may have been wrapped into a temporary block, in
+         --  which case the block itself has to be removed.
+
+         if No (Init_Call) and then Nkind (Next (Par)) = N_Block_Statement then
+            declare
+               Blk : constant Node_Id := Next (Par);
+            begin
+               if Present
+                    (Find_Init_Call_In_List
+                      (First (Statements (Handled_Statement_Sequence (Blk)))))
+               then
+                  Init_Call := Blk;
+               end if;
+            end;
+         end if;
+      end if;
+
+      if Present (Init_Call) then
+         Remove (Init_Call);
+      end if;
+      return Init_Call;
+   end Remove_Init_Call;
+
    -------------------------
    -- Remove_Side_Effects --
    -------------------------

gcc/ada/exp_util.ads

@@ -379,14 +379,6 @@ package Exp_Util is
    --  declarations and/or allocations when the type is indefinite (including
    --  class-wide).
 
-   function Find_Init_Call
-     (Var        : Entity_Id;
-      Rep_Clause : Node_Id) return Node_Id;
-   --  Look for init_proc call for variable Var, either among declarations
-   --  between that of Var and a subsequent Rep_Clause applying to Var, or
-   --  in the list of freeze actions associated with Var, and if found, return
-   --  that call node.
-
    function Find_Interface_ADT
      (T     : Entity_Id;
       Iface : Entity_Id) return Elmt_Id;
@@ -723,6 +715,14 @@ package Exp_Util is
    --  statements looking for declarations of controlled objects. If at least
    --  one such object is found, wrap the statement list in a block.
 
+   function Remove_Init_Call
+     (Var        : Entity_Id;
+      Rep_Clause : Node_Id) return Node_Id;
+   --  Look for init_proc call or aggregate initialization statements for
+   --  variable Var, either among declarations between that of Var and a
+   --  subsequent Rep_Clause applying to Var, or in the list of freeze actions
+   --  associated with Var, and if found, remove and return that call node.
+
    procedure Remove_Side_Effects
      (Exp          : Node_Id;
       Name_Req     : Boolean := False;

gcc/ada/freeze.adb

@@ -3344,6 +3344,31 @@ package body Freeze is
             then
                Layout_Object (E);
             end if;
+
+            --  If initialization statements were captured in an expression
+            --  with actions with null expression, and the object does not
+            --  have delayed freezing, move them back now directly within the
+            --  enclosing statement sequence.
+
+            if Ekind_In (E, E_Constant, E_Variable)
+                 and then not Has_Delayed_Freeze (E)
+            then
+               declare
+                  Init_Stmts : constant Node_Id :=
+                                 Initialization_Statements (E);
+               begin
+                  if Present (Init_Stmts)
+                       and then Nkind (Init_Stmts) = N_Expression_With_Actions
+                       and then Nkind (Expression (Init_Stmts))
+                         = N_Null_Statement
+                  then
+                     Insert_List_Before (Init_Stmts, Actions (Init_Stmts));
+                     Remove (Init_Stmts);
+                     Set_Initialization_Statements (E, Empty);
+                  end if;
+               end;
+            end if;
+
          end if;
 
       --  Case of a type or subtype being frozen

gcc/ada/sem_ch13.adb

@@ -2903,11 +2903,25 @@ package body Sem_Ch13 is
                   --  before its definition.
 
                   declare
-                     Init_Call : constant Node_Id := Find_Init_Call (U_Ent, N);
+                     Init_Call : constant Node_Id :=
+                                   Remove_Init_Call (U_Ent, N);
                   begin
                      if Present (Init_Call) then
-                        Remove (Init_Call);
-                        Append_Freeze_Action (U_Ent, Init_Call);
+
+                        --  If the init call is an expression with actions with
+                        --  null expression, just extract the actions.
+
+                        if Nkind (Init_Call) = N_Expression_With_Actions
+                             and then Nkind (Expression (Init_Call))
+                               = N_Null_Statement
+                        then
+                           Append_Freeze_Actions (U_Ent, Actions (Init_Call));
+
+                        --  General case: move Init_Call to freeze actions
+
+                        else
+                           Append_Freeze_Action (U_Ent, Init_Call);
+                        end if;
                      end if;
                   end;
 

gcc/ada/sem_ch3.adb

@@ -3171,14 +3171,9 @@ package body Sem_Ch3 is
             Set_Has_Completion (Id);
          end if;
 
-         --  Set kind (expansion of E may need it) and type now, and resolve.
-         --  Type might be overridden later on.
-
-         if Constant_Present (N) then
-            Set_Ekind (Id, E_Constant);
-         else
-            Set_Ekind (Id, E_Variable);
-         end if;
+         --  Set type and resolve (type may be overridden later on). Note:
+         --  Ekind (Id) must still be E_Void at this point so that incorrect
+         --  early usage within E is properly diagnosed.
 
          Set_Etype (Id, T);
          Resolve (E, T);
@@ -3520,12 +3515,11 @@ package body Sem_Ch3 is
 
       Set_Never_Set_In_Source (Id, True);
 
-      --  Now establish the proper kind (if not already set) and type of the
-      --  object.
+      --  Now establish the proper kind and type of the object
 
       if Constant_Present (N) then
+         Set_Ekind            (Id, E_Constant);
          Set_Is_True_Constant (Id, True);
-         Set_Ekind (Id, E_Constant);
 
       else
          Set_Ekind (Id, E_Variable);

gcc/ada/sinfo.ads

@@ -7020,15 +7020,10 @@ package Sinfo is
       --  a subexpression, whose value is the value of the Expression after
       --  executing all the actions.
 
-      --  Note: if the actions contain declarations, then these declarations
-      --  may be referenced within the expression. It is thus appropriate for
-      --  the back-end to create a scope that encompasses the construct (any
-      --  declarations within the actions will definitely not be referenced
-      --  once elaboration of the construct is completed).
-
-      --  But we rely on freeze nodes appearing in actions being elaborated in
-      --  the enclosing scope (see Exp_Aggr.Collect_Initialization_
-      --  Statements)???
+      --  If the actions contain declarations, then these declarations may
+      --  be referenced within the expression. However note that there is
+      --  no proper scope associated with the expression-with-action, so the
+      --  back-end will elaborate them in the context of the enclosing scope.
 
       --  Sprint syntax:  do
       --                    action;
@@ -7046,7 +7041,10 @@ package Sinfo is
       --  never have created this node if there weren't some actions.
 
       --  Note: Expression may be a Null_Statement, in which case the
-      --  N_Expression_With_Actions has type Standard_Void_Type.
+      --  N_Expression_With_Actions has type Standard_Void_Type. However some
+      --  backends do not support such expression-with-actions occurring
+      --  outside of a proper (non-void) expression, so this should just be
+      --  used as an intermediate representation within the front-end.
 
       --------------------
       -- Free Statement --
@@ -7183,7 +7181,7 @@ package Sinfo is
       --  the exception to be raised (i.e. it is equivalent to a raise
       --  statement that raises the corresponding exception). This use
       --  is distinguished by the fact that the Etype in this case is
-      --  Standard_Void_Type, In the subexpression case, the Etype is the
+      --  Standard_Void_Type; in the subexpression case, the Etype is the
       --  same as the type of the subexpression which it replaces.
 
       --  If Condition is empty, then the raise is unconditional. If the