[gcc(refs/users/giulianob/heads/autopar_rebase2)] [Ada] ACATS 4.1G - C760A02 - Near infinite finalization
Giuliano Belinassi
giulianob@gcc.gnu.org
Tue Aug 18 00:02:05 GMT 2020
https://gcc.gnu.org/g:61e1942ceccb6a496b21d5e40c4bd026ac9d9a96
commit 61e1942ceccb6a496b21d5e40c4bd026ac9d9a96
Author: Javier Miranda <miranda@adacore.com>
Date: Thu Apr 30 11:55:42 2020 -0400
[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.
Diff:
---
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);
More information about the Gcc-cvs
mailing list