[multiple changes]

2011-09-05  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb: Minor reformatting.

2011-09-05  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch5.adb: Better error message.

2011-09-05  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_aggr.adb: Add with and use clause for Exp_Ch6.
	(Expand_Array_Aggregate): Detect a special case of an aggregate
	which contains tasks in the context of an unexpanded return
	statement of a build-in-place function.
	* exp_ch6.adb: Add with and use clause for Exp_Aggr.
	(Expand_N_Extended_Return_Statement): Detect a delayed aggregate
	which contains tasks and expand it now that the original simple
	return statement has been rewritten.
	* exp_ch9.adb (Build_Activation_Chain_Entity): Code
	reformatting. Do not create a chain for an extended return
	statement if one is already available.
	(Has_Activation_Chain): New routine.

From-SVN: r178539

6 files changed, 156 insertions, 53 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e267e9b..056672d 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,26 @@
+2011-09-05  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch3.adb: Minor reformatting.
+
+2011-09-05  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch5.adb: Better error message.
+
+2011-09-05  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_aggr.adb: Add with and use clause for Exp_Ch6.
+	(Expand_Array_Aggregate): Detect a special case of an aggregate
+	which contains tasks in the context of an unexpanded return
+	statement of a build-in-place function.
+	* exp_ch6.adb: Add with and use clause for Exp_Aggr.
+	(Expand_N_Extended_Return_Statement): Detect a delayed aggregate
+	which contains tasks and expand it now that the original simple
+	return statement has been rewritten.
+	* exp_ch9.adb (Build_Activation_Chain_Entity): Code
+	reformatting. Do not create a chain for an extended return
+	statement if one is already available.
+	(Has_Activation_Chain): New routine.
+
 2011-09-05  Marc Sango  <sango@adacore.com>
 
 	* sem_ch3.adb (Analyze_Object_Declaration): Remove
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 03b686c..31b0c61 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -32,6 +32,7 @@ with Errout;   use Errout;
 with Expander; use Expander;
 with Exp_Util; use Exp_Util;
 with Exp_Ch3;  use Exp_Ch3;
+with Exp_Ch6;  use Exp_Ch6;
 with Exp_Ch7;  use Exp_Ch7;
 with Exp_Ch9;  use Exp_Ch9;
 with Exp_Disp; use Exp_Disp;
@@ -4604,6 +4605,21 @@ package body Exp_Aggr is
         or else Is_RTE (Ctyp, RE_Asm_Output_Operand)
       then
          return;
+
+      --  Do not expand an aggregate for an array type which contains tasks if
+      --  the aggregate is associated with an unexpanded return statement of a
+      --  build-in-place function. The aggregate is expanded when the related
+      --  return statement (rewritten into an extended return) is processed.
+      --  This delay ensures that any temporaries and initialization code
+      --  generated for the aggregate appear in the proper return block and
+      --  use the correct _chain and _master.
+
+      elsif Has_Task (Base_Type (Etype (N)))
+        and then Nkind (Parent (N)) = N_Simple_Return_Statement
+        and then Is_Build_In_Place_Function
+                   (Return_Applies_To (Return_Statement_Entity (Parent (N))))
+      then
+         return;
       end if;
 
       --  If the semantic analyzer has determined that aggregate N will raise
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index e8e46e1..82f1193 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -29,6 +29,7 @@ with Debug;    use Debug;
 with Einfo;    use Einfo;
 with Errout;   use Errout;
 with Elists;   use Elists;
+with Exp_Aggr; use Exp_Aggr;
 with Exp_Atag; use Exp_Atag;
 with Exp_Ch2;  use Exp_Ch2;
 with Exp_Ch3;  use Exp_Ch3;
@@ -4768,6 +4769,15 @@ package body Exp_Ch6 is
          if Is_Build_In_Place
            and then Has_Task (Etype (Par_Func))
          then
+            --  The return expression is an aggregate for a complex type which
+            --  contains tasks. This particular case is left unexpanded since
+            --  the regular expansion would insert all temporaries and
+            --  initialization code in the wrong block.
+
+            if Nkind (Exp) = N_Aggregate then
+               Expand_N_Aggregate (Exp);
+            end if;
+
             Append_To (Stmts, Move_Activation_Chain);
          end if;
 
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index ad7f6b1..542ae61 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -843,72 +843,121 @@ package body Exp_Ch9 is
    -----------------------------------
 
    procedure Build_Activation_Chain_Entity (N : Node_Id) is
-      P     : Node_Id;
+      function Has_Activation_Chain (Stmt : Node_Id) return Boolean;
+      --  Determine whether an extended return statement has an activation
+      --  chain.
+
+      --------------------------
+      -- Has_Activation_Chain --
+      --------------------------
+
+      function Has_Activation_Chain (Stmt : Node_Id) return Boolean is
+         Decl : Node_Id;
+
+      begin
+         Decl := First (Return_Object_Declarations (Stmt));
+         while Present (Decl) loop
+            if Nkind (Decl) = N_Object_Declaration
+              and then Chars (Defining_Identifier (Decl)) = Name_uChain
+            then
+               return True;
+            end if;
+
+            Next (Decl);
+         end loop;
+
+         return False;
+      end Has_Activation_Chain;
+
+      --  Local variables
+
       Decls : List_Id;
-      Chain : Entity_Id;
+      Par   : Node_Id;
+
+   --  Start of processing for Build_Activation_Chain_Entity
 
    begin
-      --  Loop to find enclosing construct containing activation chain variable
-      --  The construct is a body, a block, or an extended return.
-
-      P := Parent (N);
-
-      while not Nkind_In (P, N_Subprogram_Body,
-                             N_Entry_Body,
-                             N_Package_Declaration,
-                             N_Package_Body,
-                             N_Block_Statement,
-                             N_Task_Body,
-                             N_Extended_Return_Statement)
+      --  Traverse the parent chain looking for an enclosing construct which
+      --  contains an activation chain variable. The construct is either a
+      --  body, a block, or an extended return.
+
+      Par := Parent (N);
+
+      while not Nkind_In (Par, N_Block_Statement,
+                               N_Entry_Body,
+                               N_Extended_Return_Statement,
+                               N_Package_Body,
+                               N_Package_Declaration,
+                               N_Subprogram_Body,
+                               N_Task_Body)
       loop
-         P := Parent (P);
+         Par := Parent (Par);
       end loop;
 
-      --  If we are in a package body, the activation chain variable is
-      --  declared in the body, but the Activation_Chain_Entity is attached
-      --  to the spec.
+      --  When the enclosing construct is a package body, the activation chain
+      --  variable is declared in the body, but the Activation_Chain_Entity is
+      --  attached to the spec.
 
-      if Nkind (P) = N_Package_Body then
-         Decls := Declarations (P);
-         P := Unit_Declaration_Node (Corresponding_Spec (P));
+      if Nkind (Par) = N_Package_Body then
+         Decls := Declarations (Par);
+         Par   := Unit_Declaration_Node (Corresponding_Spec (Par));
 
-      elsif Nkind (P) = N_Package_Declaration then
-         Decls := Visible_Declarations (Specification (P));
+      elsif Nkind (Par) = N_Package_Declaration then
+         Decls := Visible_Declarations (Specification (Par));
 
-      elsif Nkind (P) = N_Extended_Return_Statement then
-         Decls := Return_Object_Declarations (P);
+      elsif Nkind (Par) = N_Extended_Return_Statement then
+         Decls := Return_Object_Declarations (Par);
 
       else
-         Decls := Declarations (P);
+         Decls := Declarations (Par);
       end if;
 
-      --  If activation chain entity not already declared, declare it
+      --  If an activation chain entity has not been declared already, create
+      --  one.
 
-      if Nkind (P) = N_Extended_Return_Statement
-        or else No (Activation_Chain_Entity (P))
+      if Nkind (Par) = N_Extended_Return_Statement
+        or else No (Activation_Chain_Entity (Par))
       then
-         Chain := Make_Defining_Identifier (Sloc (N), Name_uChain);
-
-         --  Note: An extended return statement is not really a task activator,
-         --  but it does have an activation chain on which to store the tasks
-         --  temporarily. On successful return, the tasks on this chain are
-         --  moved to the chain passed in by the caller. We do not build an
-         --  Activation_Chain_Entity for an N_Extended_Return_Statement,
-         --  because we do not want to build a call to Activate_Tasks. Task
-         --  activation is the responsibility of the caller.
-
-         if Nkind (P) /= N_Extended_Return_Statement then
-            Set_Activation_Chain_Entity (P, Chain);
+         --  Since extended return statements do not store the entity of the
+         --  chain, examine the return object declarations to avoid creating
+         --  a duplicate.
+
+         if Nkind (Par) = N_Extended_Return_Statement
+           and then Has_Activation_Chain (Par)
+         then
+            return;
          end if;
 
-         Prepend_To (Decls,
-           Make_Object_Declaration (Sloc (P),
-             Defining_Identifier => Chain,
-             Aliased_Present => True,
-             Object_Definition =>
-               New_Reference_To (RTE (RE_Activation_Chain), Sloc (P))));
+         declare
+            Chain : Entity_Id;
+            Decl  : Node_Id;
 
-         Analyze (First (Decls));
+         begin
+            Chain := Make_Defining_Identifier (Sloc (N), Name_uChain);
+
+            --  Note: An extended return statement is not really a task
+            --  activator, but it does have an activation chain on which to
+            --  store the tasks temporarily. On successful return, the tasks
+            --  on this chain are moved to the chain passed in by the caller.
+            --  We do not build an Activation_Chain_Entity for an extended
+            --  return statement, because we do not want to build a call to
+            --  Activate_Tasks. Task activation is the responsibility of the
+            --  caller.
+
+            if Nkind (Par) /= N_Extended_Return_Statement then
+               Set_Activation_Chain_Entity (Par, Chain);
+            end if;
+
+            Decl :=
+              Make_Object_Declaration (Sloc (Par),
+                Defining_Identifier => Chain,
+                Aliased_Present     => True,
+                Object_Definition   =>
+                  New_Reference_To (RTE (RE_Activation_Chain), Sloc (Par)));
+
+            Prepend_To (Decls, Decl);
+            Analyze (Decl);
+         end;
       end if;
    end Build_Activation_Chain_Entity;
 
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 2953141..b5ee8fe 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -3270,8 +3270,11 @@ package body Sem_Ch3 is
          --  In SPARK, a declaration of unconstrained type is allowed
          --  only for constants of type string.
 
+         --  Why do we need to test Original_Node here ???
+
          if Is_String_Type (T)
-           and then not Constant_Present (Original_Node (N)) then
+           and then not Constant_Present (Original_Node (N))
+         then
             Check_SPARK_Restriction
               ("declaration of object of unconstrained type not allowed",
                N);
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 81153fa..36b9e31 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -2337,13 +2337,15 @@ package body Sem_Ch5 is
          if Of_Present (N) then
             Set_Etype (Def_Id, Component_Type (Typ));
 
-         elsif Ada_Version < Ada_2012 then
+         else
             Error_Msg_N
               ("missing Range attribute in iteration over an array", N);
 
-         else
-            Error_Msg_N
-              ("to iterate over the elements of an array, use OF", N);
+            if Ada_Version >= Ada_2012 then
+               Error_Msg_NE
+                 ("\if& is meant to designate an element of the array, use OF",
+                    N, Def_Id);
+            end if;
 
             --  Prevent cascaded errors