From 0d566e0157b969d5868a157e73a75b6b5bff4bb8 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Mon, 5 Sep 2011 13:08:30 +0000 Subject: [PATCH] exp_ch6.adb (Build_In_Place_Formal): If extra formals are not present, create them now. 2011-09-05 Ed Schonberg * exp_ch6.adb (Build_In_Place_Formal): If extra formals are not present, create them now. Needed in case the return type was a limited view in the function declaration. (Make_Build_In_Place_Call_In_Allocator): If return type contains tasks, build the activation chain for it. Pass a reference to the Master_Id in call to Add_Task_Actuals_To_Build_In_Place call. * exp_ch7.adb (Make_Set_Finalize_Address_Call): Clean up interface with build_in_place calls. * sem_ch9.adb (Analyze_Task_Type_Declaration): If partial view was incomplete, inatialize its Corresponding_Record_Type component. * sem_ch10.adb (Build_Chain): Initialize Private_Dependents field of limited views. From-SVN: r178534 --- gcc/ada/ChangeLog | 15 ++++++++++++++ gcc/ada/exp_ch6.adb | 30 +++++++++++++++++++++++++-- gcc/ada/exp_ch7.adb | 49 +++++++++++++++++++++++++++++++++++++++----- gcc/ada/sem_ch10.adb | 6 ++++++ gcc/ada/sem_ch9.adb | 14 ++++++++++--- 5 files changed, 104 insertions(+), 10 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 082b45ef1ef..f7e2e850b76 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2011-09-05 Ed Schonberg + + * exp_ch6.adb (Build_In_Place_Formal): If extra formals are not + present, create them now. Needed in case the return type was + a limited view in the function declaration. + (Make_Build_In_Place_Call_In_Allocator): If return type contains + tasks, build the activation chain for it. Pass a reference to + the Master_Id in call to Add_Task_Actuals_To_Build_In_Place call. + * exp_ch7.adb (Make_Set_Finalize_Address_Call): Clean up interface + with build_in_place calls. + * sem_ch9.adb (Analyze_Task_Type_Declaration): If partial view was + incomplete, inatialize its Corresponding_Record_Type component. + * sem_ch10.adb (Build_Chain): Initialize Private_Dependents field + of limited views. + 2011-09-05 Johannes Kanig * lib-xref-alfa.adb (Is_Alfa_Reference): Filter constants from effect diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 3ff42b620e6..a9a2c42c9d8 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -562,6 +562,16 @@ package body Exp_Ch6 is -- Maybe it would be better for each implicit formal of a build-in-place -- function to have a flag or a Uint attribute to identify it. ??? + -- The return type in the function declaration may have been a limited + -- view, and the extra formals for the function were not generated at + -- that point. At the point of call the full view must be available and + -- the extra formals can be created. + + if No (Extra_Formal) then + Create_Extra_Formals (Func); + Extra_Formal := Extra_Formals (Func); + end if; + loop pragma Assert (Present (Extra_Formal)); exit when @@ -7127,6 +7137,13 @@ package body Exp_Ch6 is Result_Subt := Etype (Function_Id); + -- Check whether return type includes tasks. This may not have been done + -- previously, if the type was a limited view. + + if Has_Task (Result_Subt) then + Build_Activation_Chain_Entity (Allocator); + end if; + -- When the result subtype is constrained, the return object must be -- allocated on the caller side, and access to it is passed to the -- function. @@ -7219,8 +7236,17 @@ package body Exp_Ch6 is Add_Finalization_Master_Actual_To_Build_In_Place_Call (Func_Call, Function_Id, Acc_Type); - Add_Task_Actuals_To_Build_In_Place_Call - (Func_Call, Function_Id, Master_Actual => Master_Id (Acc_Type)); + -- Is access type has a master entity, pass a reference to it. + + if Present (Master_Id (Acc_Type)) then + Add_Task_Actuals_To_Build_In_Place_Call + (Func_Call, Function_Id, + Master_Actual => + New_Occurrence_Of (Master_Id (Acc_Type), Loc)); + else + Add_Task_Actuals_To_Build_In_Place_Call + (Func_Call, Function_Id, Empty); + end if; -- The caller does not provide the return object in this case, so we -- have to pass null for the object access actual. diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 15980234386..59d2cb18dc9 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -3890,6 +3890,14 @@ package body Exp_Ch7 is No_Body := True; end if; + -- For a nested instance, delay processing until freeze point. + + if Has_Delayed_Freeze (Id) + and then Nkind (Parent (N)) /= N_Compilation_Unit + then + return; + end if; + -- For a package declaration that implies no associated body, generate -- task activation call and RACW supporting bodies now (since we won't -- have a specific separate compilation unit for that). @@ -7450,9 +7458,12 @@ package body Exp_Ch7 is Typ : Entity_Id; Ptr_Typ : Entity_Id) return Node_Id is - Desig_Typ : constant Entity_Id := - Available_View (Designated_Type (Ptr_Typ)); - Utyp : Entity_Id; + Desig_Typ : constant Entity_Id := + Available_View (Designated_Type (Ptr_Typ)); + Fin_Mas_Id : constant Entity_Id := Finalization_Master (Ptr_Typ); + Call : Node_Id; + Fin_Mas_Ref : Node_Id; + Utyp : Entity_Id; begin -- If the context is a class-wide allocator, we use the class-wide type @@ -7503,19 +7514,47 @@ package body Exp_Ch7 is Utyp := Base_Type (Utyp); end if; + Fin_Mas_Ref := New_Occurrence_Of (Fin_Mas_Id, Loc); + + -- If the call is from a build-in-place function, the Master parameter + -- is actually a pointer. Dereference it for the call. + + if Is_Access_Type (Etype (Fin_Mas_Id)) then + Fin_Mas_Ref := Make_Explicit_Dereference (Loc, Fin_Mas_Ref); + end if; + -- Generate: -- Set_Finalize_Address (FM, FD'Unrestricted_Access); - return + Call := Make_Procedure_Call_Statement (Loc, Name => New_Reference_To (RTE (RE_Set_Finalize_Address), Loc), Parameter_Associations => New_List ( - New_Reference_To (Finalization_Master (Ptr_Typ), Loc), + Fin_Mas_Ref, Make_Attribute_Reference (Loc, Prefix => New_Reference_To (TSS (Utyp, TSS_Finalize_Address), Loc), Attribute_Name => Name_Unrestricted_Access))); + + -- In the case of build-in-place functions, protect the call to ensure + -- we have a master at runtime. Generate: + + -- if FM /= null then + -- ; + -- end if; + + if Is_Access_Type (Etype (Fin_Mas_Id)) then + Call := + Make_If_Statement (Loc, + Condition => + Make_Op_Ne (Loc, + Left_Opnd => New_Reference_To (Fin_Mas_Id, Loc), + Right_Opnd => Make_Null (Loc)), + Then_Statements => New_List (Call)); + end if; + + return Call; end Make_Set_Finalize_Address_Call; -------------------------- diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 87334e43ff8..33d8dda47e0 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -5393,6 +5393,7 @@ package body Sem_Ch10 is end if; Set_Non_Limited_View (Lim_Typ, Comp_Typ); + Set_Private_Dependents (Lim_Typ, New_Elmt_List); elsif Nkind_In (Decl, N_Private_Type_Declaration, N_Incomplete_Type_Declaration, @@ -5432,6 +5433,11 @@ package body Sem_Ch10 is Set_Non_Limited_View (Lim_Typ, Comp_Typ); + -- Initialize Private_Depedents, so the field has the proper + -- type, even though the list will remain empty. + + Set_Private_Dependents (Lim_Typ, New_Elmt_List); + elsif Nkind (Decl) = N_Private_Extension_Declaration then Comp_Typ := Defining_Identifier (Decl); diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index cdac2f787d3..5fbb0ecb97e 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -2001,10 +2001,18 @@ package body Sem_Ch9 is -- In the case of an incomplete type, use the full view, unless it's not -- present (as can occur for an incomplete view from a limited with). + -- Initialize the Corresponding_Record_Type (which overlays the Private + -- Dependents field of the incomplete view). - if Ekind (T) = E_Incomplete_Type and then Present (Full_View (T)) then - T := Full_View (T); - Set_Completion_Referenced (T); + if Ekind (T) = E_Incomplete_Type then + if Present (Full_View (T)) then + T := Full_View (T); + Set_Completion_Referenced (T); + + else + Set_Ekind (T, E_Task_Type); + Set_Corresponding_Record_Type (T, Empty); + end if; end if; Set_Ekind (T, E_Task_Type); -- 2.30.2