From 7841c99268adfaba9c30be23ce7569c85cae52dc Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Thu, 30 Apr 2020 11:55:42 -0400 Subject: [PATCH] [Ada] ACATS 4.1G - C760A02 - Near infinite finalization 2020-06-19 Javier Miranda gcc/ada/ * exp_ch3.ads (Ensure_Activation_Chain_And_Master): New subprogram. * exp_ch3.adb (Ensure_Activation_Chain_And_Master): New subprogram that factorizes code. (Expand_N_Object_Declaration): Call new subprogram. * sem_ch6.adb (Analyze_Function_Return): Returning a build-in-place unconstrained array type defer the full analysis of the returned object to avoid generating the corresponding constrained subtype; otherwise the bounds would be created in the stack and a dangling reference would be returned pointing to the bounds. --- gcc/ada/exp_ch3.adb | 71 +++++++++++++++++++++++++++------------------ gcc/ada/exp_ch3.ads | 7 +++++ gcc/ada/sem_ch6.adb | 29 +++++++++++++++++- 3 files changed, 77 insertions(+), 30 deletions(-) diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index f89e070918d..7d847329378 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -4764,6 +4764,47 @@ package body Exp_Ch3 is end if; end Clean_Task_Names; + ---------------------------------------- + -- Ensure_Activation_Chain_And_Master -- + ---------------------------------------- + + procedure Ensure_Activation_Chain_And_Master (Obj_Decl : Node_Id) is + Def_Id : constant Entity_Id := Defining_Identifier (Obj_Decl); + Expr : constant Node_Id := Expression (Obj_Decl); + Expr_Q : Node_Id; + Typ : constant Entity_Id := Etype (Def_Id); + + begin + pragma Assert (Nkind (Obj_Decl) = N_Object_Declaration); + + if Has_Task (Typ) or else Might_Have_Tasks (Typ) then + Build_Activation_Chain_Entity (Obj_Decl); + + if Has_Task (Typ) then + Build_Master_Entity (Def_Id); + + -- Handle objects initialized with BIP function calls + + elsif Present (Expr) then + if Nkind (Expr) = N_Qualified_Expression then + Expr_Q := Expression (Expr); + else + Expr_Q := 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 if; + end if; + end Ensure_Activation_Chain_And_Master; + ------------------------------ -- Expand_Freeze_Array_Type -- ------------------------------ @@ -6743,35 +6784,7 @@ package body Exp_Ch3 is -- also that a Master variable is established (and that the appropriate -- enclosing construct is established as a task master). - if Has_Task (Typ) or else Might_Have_Tasks (Typ) then - Build_Activation_Chain_Entity (N); - - 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; + Ensure_Activation_Chain_And_Master (N); -- If No_Implicit_Heap_Allocations or No_Implicit_Task_Allocations -- restrictions are active then default-sized secondary stacks are diff --git a/gcc/ada/exp_ch3.ads b/gcc/ada/exp_ch3.ads index fcbe83befaa..954b5a24a2b 100644 --- a/gcc/ada/exp_ch3.ads +++ b/gcc/ada/exp_ch3.ads @@ -101,6 +101,13 @@ package Exp_Ch3 is -- Build the body of the equality function Body_Id for the untagged variant -- record Typ with the given parameters specification list. + procedure Ensure_Activation_Chain_And_Master (Obj_Decl : Node_Id); + -- If tasks are being declared (or might be declared) by the given object + -- declaration then ensure to 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). + function Freeze_Type (N : Node_Id) return Boolean; -- This function executes the freezing actions associated with the given -- freeze type node N and returns True if the node is to be deleted. We diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 96099e77b43..59cbccdafa0 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -32,6 +32,7 @@ with Einfo; use Einfo; with Elists; use Elists; with Errout; use Errout; with Expander; use Expander; +with Exp_Ch3; use Exp_Ch3; with Exp_Ch6; use Exp_Ch6; with Exp_Ch7; use Exp_Ch7; with Exp_Ch9; use Exp_Ch9; @@ -1194,7 +1195,33 @@ package body Sem_Ch6 is -- object declaration. Set_Is_Return_Object (Defining_Identifier (Obj_Decl)); - Analyze (Obj_Decl); + + -- Returning a build-in-place unconstrained array type we defer + -- the full analysis of the returned object to avoid generating + -- the corresponding constrained subtype; otherwise the bounds + -- would be created in the stack and a dangling reference would + -- be returned pointing to the bounds. We perform its preanalysis + -- to report errors on the initializing aggregate now (if any); + -- we also ensure its activation chain and Master variable are + -- defined (if tasks are being declared) since they are generated + -- as part of the analysis and expansion of the object declaration + -- at this stage. + + if Is_Array_Type (R_Type) + and then not Is_Constrained (R_Type) + and then Is_Build_In_Place_Function (Scope_Id) + and then Needs_BIP_Alloc_Form (Scope_Id) + and then Nkind_In (Expr, N_Aggregate, N_Extension_Aggregate) + then + Preanalyze (Obj_Decl); + + if Expander_Active then + Ensure_Activation_Chain_And_Master (Obj_Decl); + end if; + + else + Analyze (Obj_Decl); + end if; Check_Return_Subtype_Indication (Obj_Decl); -- 2.30.2