exp_aggr.adb (Expand_Array_Aggregate): If the aggregate contains tasks...

2008-05-27  Ed Schonberg  <schonberg@adacore.com>

	* exp_aggr.adb (Expand_Array_Aggregate): If the aggregate contains
	tasks, create an activation chain now, before the expansion into
	assignments and build-in-place calls that require the presence of an
	activation chain.
	(Backend_Processing_Possible): If the component type is inherently
	limited, the aggregate must be expanded into individual built-in-place
	assignments.

	* sem_ch6.adb (Build_Extra_Formals): Use underlying type of result to
	determine whether an allocation extra parameter must be built, to
	handle case of a private type whose full type is a discriminated type
	with defaults.

From-SVN: r136016

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 0fca31e..08e23ab 100644 (file)
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -544,6 +544,13 @@ package body Exp_Aggr is
          return False;
       end if;
 
+      --  If component is limited, aggregate must be expanded because each
+      --  component assignment must be built in place.
+
+      if Is_Inherently_Limited_Type (Component_Type (Typ)) then
+         return False;
+      end if;
+
       --  Checks 4 (array must not be multi-dimensional Fortran case)
 
       if Convention (Typ) = Convention_Fortran
@@ -4955,6 +4962,13 @@ package body Exp_Aggr is
               and then In_Place_Assign_OK);
       end if;
 
+      --  If  this is an array of tasks, it will be expanded into build-in-
+      --  -place assignments. Build an activation chain for the tasks now
+
+      if Has_Task (Etype (N)) then
+         Build_Activation_Chain_Entity (N);
+      end if;
+
       if not Has_Default_Init_Comps (N)
          and then Comes_From_Source (Parent (N))
          and then Nkind (Parent (N)) = N_Object_Declaration

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 14a305b..f8bd8d4 100644 (file)
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -1602,6 +1602,7 @@ package body Sem_Ch6 is
             elsif Nkind (Parent (N)) = N_Compilation_Unit then
                Freeze_Before (N, Spec_Id);
             end if;
+
          else
             Spec_Id := Corresponding_Spec (N);
          end if;
@@ -2459,18 +2460,17 @@ package body Sem_Ch6 is
          Push_Scope (Designator);
          Process_Formals (Formals, N);
 
-         --  Ada 2005 (AI-345): Allow the overriding of interface primitives
-         --  by subprograms which belong to a concurrent type implementing an
-         --  interface. Set the parameter type of each controlling formal to
-         --  the corresponding record type.
+         --  Ada 2005 (AI-345): If this is an overriding operation of an
+         --  inherited interface operation, and the controlling type is
+         --  a synchronized type, replace the type with its corresponding
+         --  record, to match the proper signature of an overriding operation.
 
          if Ada_Version >= Ada_05 then
             Formal := First_Formal (Designator);
             while Present (Formal) loop
                Formal_Typ := Etype (Formal);
 
-               if (Ekind (Formal_Typ) = E_Protected_Type
-                     or else Ekind (Formal_Typ) = E_Task_Type)
+               if Is_Concurrent_Type (Formal_Typ)
                  and then Present (Corresponding_Record_Type (Formal_Typ))
                  and then Present (Interfaces
                                     (Corresponding_Record_Type (Formal_Typ)))
@@ -5001,7 +5001,7 @@ package body Sem_Ch6 is
             --  can be called in a dispatching context and such calls must be
             --  handled like calls to a class-wide function.
 
-            if not Is_Constrained (Result_Subt)
+            if not Is_Constrained (Underlying_Type (Result_Subt))
               or else Is_Tagged_Type (Underlying_Type (Result_Subt))
             then
                Discard :=