From a7837c085aa5538430cdc9ffc04fcfa1f581656f Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Sat, 28 Mar 2020 14:52:14 -0400 Subject: [Ada] Crash in tagged type constructor with task components 2020-06-15 Javier Miranda gcc/ada/ * restrict.ads (Set_Global_No_Tasking, Global_No_Tasking): New subprograms. * restrict.adb (Set_Global_No_Tasking, Global_No_Tasking): New subprograms. * sem_ch3.adb (Access_Definition): Do not skip building masters since they may be required for BIP calls. (Analyze_Subtype_Declaration): Propagate attribute Is_Limited_Record in class-wide subtypes and subtypes with cloned subtype attribute; propagate attribute Is_Limited_Interface. * sem_ch6.adb (Check_Anonymous_Return): Do not skip building masters since they may be required for BIP calls. Use Build_Master_Declaration to declare the _master variable. (Create_Extra_Formals): Add decoration of Has_Master_Entity when the _master formal is added. * exp_ch3.adb (Init_Formals): Adding formal to decorate it with attribute Has_Master_Entity when the _master formal is added. (Build_Master): Do not skip building masters since they may be required for BIP calls. (Expand_N_Object_Declaration): Ensure activation chain and master entity for objects initialized with BIP function calls. * sem_prag.adb (Process_Restrictions_Or_Restriction_Warnings): Adding support to detect and save restriction No_Tasking when set in the run-time package System or in a global configuration pragmas file. * sem_util.adb (Current_Entity_In_Scope): Overload this subprogram to allow searching for an entity by its Name. * sem_util.ads (Current_Entity_In_Scope): Update comment. * exp_ch4.adb (Expand_N_Allocator): Do not skip building masters since they may be required for BIP calls. * exp_ch6.ads (Might_Have_Tasks): New subprogram. * exp_ch6.adb (Make_Build_In_Place_Call_In_Allocator): Add support for BIP calls returning objects that may have tasks. (Make_Build_In_Place_Call_In_Allocator): Build the activation chain if the result might have tasks. (Make_Build_In_Place_Iface_Call_In_Allocator): Build the class wide master for the result type. (Might_Have_Tasks): New subprogram. (Needs_BIP_Task_Actuals): Returns False when restriction No_Tasking is globally set. * exp_ch9.ads (Build_Master_Declaration): New subprogram. * exp_ch9.adb (Build_Activation_Chain_Entity): No action performed when restriction No_Tasking is globally set. (Build_Class_Wide_Master): No action performed when restriction No_Tasking is globally set; use Build_Master_Declaration to declare the _master variable. (Build_Master_Declaration): New subprogram. (Build_Master_Entity): No action performed when restriction No_Tasking is globally set; added support to handle transient scopes and _finalizer routines. (Build_Master_Renaming): No action performed when restriction No_Tasking is globally set. (Build_Task_Activation_Call): Skip generating the call when the chain is an ignored ghost entity. (Find_Master_Scope): Generalize the code that detects transient scopes with master entity. * einfo.ads (Has_Nested_Subprogram): Minor comment reformatting. --- gcc/ada/exp_ch3.adb | 65 ++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 47 insertions(+), 18 deletions(-) (limited to 'gcc/ada/exp_ch3.adb') diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 7d13cd6..b207a1f 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -184,11 +184,11 @@ package body Exp_Ch3 is -- E is a type, it has components that have no static initialization. -- if E is an entity, its initial expression is not compile-time known. - function Init_Formals (Typ : Entity_Id) return List_Id; + function Init_Formals (Typ : Entity_Id; Proc_Id : Entity_Id) return List_Id; -- This function builds the list of formals for an initialization routine. -- The first formal is always _Init with the given type. For task value -- record types and types containing tasks, three additional formals are - -- added: + -- added and Proc_Id is decorated with attribute Has_Master_Entity: -- -- _Master : Master_Id -- _Chain : in out Activation_Chain @@ -730,7 +730,7 @@ package body Exp_Ch3 is end if; Body_Stmts := Init_One_Dimension (1); - Parameters := Init_Formals (A_Type); + Parameters := Init_Formals (A_Type, Proc_Id); Discard_Node ( Make_Subprogram_Body (Loc, @@ -2438,7 +2438,7 @@ package body Exp_Ch3 is Proc_Spec_Node := New_Node (N_Procedure_Specification, Loc); Set_Defining_Unit_Name (Proc_Spec_Node, Proc_Id); - Parameters := Init_Formals (Rec_Type); + Parameters := Init_Formals (Rec_Type, Proc_Id); Append_List_To (Parameters, Build_Discriminant_Formals (Rec_Type, True)); @@ -5720,7 +5720,7 @@ package body Exp_Ch3 is -- record parameter for an entry declaration. No master is created -- for such a type. - if Comes_From_Source (N) and then Has_Task (Desig_Typ) then + if Has_Task (Desig_Typ) then Build_Master_Entity (Ptr_Typ); Build_Master_Renaming (Ptr_Typ); @@ -5734,12 +5734,11 @@ package body Exp_Ch3 is -- Suppress the master creation for access types created for entry -- formal parameters (parameter block component types). Seems like -- suppression should be more general for compiler-generated types, - -- but testing Comes_From_Source, like the code above does, may be - -- too general in this case (affects some test output)??? + -- but testing Comes_From_Source may be too general in this case + -- (affects some test output)??? elsif not Is_Param_Block_Component_Type (Ptr_Typ) and then Is_Limited_Class_Wide_Type (Desig_Typ) - and then Tasking_Allowed then Build_Class_Wide_Master (Ptr_Typ); end if; @@ -6666,14 +6665,39 @@ package body Exp_Ch3 is Init_After := Make_Shared_Var_Procs (N); end if; - -- If tasks being declared, make sure we have an activation chain + -- If tasks are being declared, make sure we have an activation chain -- defined for the tasks (has no effect if we already have one), and - -- also that a Master variable is established and that the appropriate - -- enclosing construct is established as a task master. + -- also that a Master variable is established (and that the appropriate + -- enclosing construct is established as a task master). - if Has_Task (Typ) then + if Has_Task (Typ) or else Might_Have_Tasks (Typ) then Build_Activation_Chain_Entity (N); - Build_Master_Entity (Def_Id); + + if Has_Task (Typ) then + Build_Master_Entity (Def_Id); + + -- Handle objects initialized with BIP function calls + + elsif Present (Expr) then + declare + Expr_Q : Node_Id := Expr; + + begin + if Nkind (Expr) = N_Qualified_Expression then + Expr_Q := Expression (Expr); + end if; + + if Is_Build_In_Place_Function_Call (Expr_Q) + or else Present (Unqual_BIP_Iface_Function_Call (Expr_Q)) + or else + (Nkind (Expr_Q) = N_Reference + and then + Is_Build_In_Place_Function_Call (Prefix (Expr_Q))) + then + Build_Master_Entity (Def_Id); + end if; + end; + end if; end if; -- If No_Implicit_Heap_Allocations or No_Implicit_Task_Allocations @@ -6691,7 +6715,7 @@ package body Exp_Ch3 is -- of the stacks in this scenario, the stacks of the first array are -- not counted. - if Has_Task (Typ) + if (Has_Task (Typ) or else Might_Have_Tasks (Typ)) and then not Restriction_Active (No_Secondary_Stack) and then (Restriction_Active (No_Implicit_Heap_Allocations) or else Restriction_Active (No_Implicit_Task_Allocations)) @@ -8862,7 +8886,8 @@ package body Exp_Ch3 is -- Init_Formals -- ------------------ - function Init_Formals (Typ : Entity_Id) return List_Id is + function Init_Formals (Typ : Entity_Id; Proc_Id : Entity_Id) return List_Id + is Loc : constant Source_Ptr := Sloc (Typ); Unc_Arr : constant Boolean := Is_Array_Type (Typ) and then not Is_Constrained (Typ); @@ -8871,9 +8896,11 @@ package body Exp_Ch3 is or else (Is_Record_Type (Typ) and then Is_Protected_Record_Type (Typ)); With_Task : constant Boolean := - Has_Task (Typ) - or else (Is_Record_Type (Typ) - and then Is_Task_Record_Type (Typ)); + not Global_No_Tasking + and then + (Has_Task (Typ) + or else (Is_Record_Type (Typ) + and then Is_Task_Record_Type (Typ))); Formals : List_Id; begin @@ -8902,6 +8929,8 @@ package body Exp_Ch3 is Parameter_Type => New_Occurrence_Of (RTE (RE_Master_Id), Loc))); + Set_Has_Master_Entity (Proc_Id); + -- Add _Chain (not done for sequential elaboration policy, see -- comment for Create_Restricted_Task_Sequential in s-tarest.ads). -- cgit v1.1