OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[Ada] ACATS 4.1G - C760A02 - Near infinite finalization 

2020-06-19  Javier Miranda  <miranda@adacore.com>

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.
This commit is contained in:
Javier Miranda 2020-04-30 11:55:42 -04:00 committed by Pierre-Marie de Rodat
parent b6c2ec4997
commit 7841c99268
3 changed files with 77 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

71
gcc/ada/exp_ch3.adb
View File

@ -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

7
gcc/ada/exp_ch3.ads
View File

@ -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

29
gcc/ada/sem_ch6.adb
View File

@ -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);