From a38ff9b14f4fce37eb0d96236dfae843a2e038b2 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Tue, 27 May 2008 13:55:00 +0200 Subject: [PATCH] exp_aggr.adb (Expand_Array_Aggregate): If the aggregate contains tasks... 2008-05-27 Ed Schonberg * 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 --- gcc/ada/exp_aggr.adb | 14 ++++++++++++++ gcc/ada/sem_ch6.adb | 14 +++++++------- 2 files changed, 21 insertions(+), 7 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 0fca31e3d2a..08e23ab35df 100644 --- 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 14a305b5090..f8bd8d49853 100644 --- 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 := -- 2.30.2