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

exp_ch7.adb (Find_Final_List): Change the test for generating a selected component from an access type's... 

2008-04-08  Gary Dismukes  <dismukes@adacore.com>
	    Thomas Quinot  <quinot@adacore.com>

	* exp_ch7.adb (Find_Final_List): Change the test for generating a
	selected component from an access type's Associated_Final_Chain to
	check for the presence of that field, rather than assuming it exists
	for all named access types.
	(Make_Clean): New formal Chained_Cleanup_Action allowing to specify a
	procedure to call at the end of the generated cleanup procedure.
	(Expand_Cleanup_Actions): When a new cleanup procedure is generated, and
	and an At_End_Proc already exists in the handled sequence of statements
	for which cleanup actions are being expanded, the original cleanup
	action must be preserved.

From-SVN: r134029
This commit is contained in:
Gary Dismukes 2008-04-08 08:50:34 +02:00 committed by Arnaud Charlet
parent 70f9118087
commit dcfa065d7c
1 changed files with 74 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

113
gcc/ada/exp_ch7.adb
View File

@ -137,18 +137,20 @@ package body Exp_Ch7 is
Is_Master : Boolean;
Is_Protected_Subprogram : Boolean;
Is_Task_Allocation_Block : Boolean;
Is_Asynchronous_Call_Block : Boolean) return Node_Id;
-- Expand the clean-up procedure for controlled and/or transient
-- block, and/or task master or task body, or blocks used to
-- implement task allocation or asynchronous entry calls, or
-- procedures used to implement protected procedures. Clean is the
-- entity for such a procedure. Mark is the entity for the secondary
-- stack mark, if empty only controlled block clean-up will be
-- performed. Flist is the entity for the local final list, if empty
-- only transient scope clean-up will be performed. The flags
-- Is_Task and Is_Master control the calls to the corresponding
-- finalization actions for a task body or for an entity that is a
-- task master.
Is_Asynchronous_Call_Block : Boolean;
Chained_Cleanup_Action : Node_Id) return Node_Id;
-- Expand the clean-up procedure for a controlled and/or transient block,
-- and/or task master or task body, or a block used to implement task
-- allocation or asynchronous entry calls, or a procedure used to implement
-- protected procedures. Clean is the entity for such a procedure. Mark
-- is the entity for the secondary stack mark, if empty only controlled
-- block clean-up will be performed. Flist is the entity for the local
-- final list, if empty only transient scope clean-up will be performed.
-- The flags Is_Task and Is_Master control the calls to the corresponding
-- finalization actions for a task body or for an entity that is a task
-- master. Finally if Chained_Cleanup_Action is present, it is a reference
-- to a previous cleanup procedure, a call to which is appended at the
-- end of the generated one.
procedure Set_Node_To_Be_Wrapped (N : Node_Id);
-- Set the field Node_To_Be_Wrapped of the current scope
@ -1120,6 +1122,9 @@ package body Exp_Ch7 is
Nkind (N) = N_Block_Statement
and then Is_Asynchronous_Call_Block (N);
Previous_At_End_Proc : constant Node_Id :=
At_End_Proc (Handled_Statement_Sequence (N));
Clean : Entity_Id;
Loc : Source_Ptr;
Mark : Entity_Id := Empty;
@ -1244,11 +1249,18 @@ package body Exp_Ch7 is
Is_Master,
Is_Protected,
Is_Task_Allocation,
Is_Asynchronous_Call));
Is_Asynchronous_Call,
Previous_At_End_Proc));
-- If exception handlers are present, wrap the Sequence of
-- statements in a block because it is not possible to get
-- exception handlers and an AT END call in the same scope.
-- The previous AT END procedure, if any, has been captured in Clean:
-- reset it to Empty now because we check further on that we never
-- overwrite an existing AT END call.
Set_At_End_Proc (Handled_Statement_Sequence (N), Empty);
-- If exception handlers are present, wrap the Sequence of statements in
-- a block because it is not possible to get exception handlers and an
-- AT END call in the same scope.
if Present (Exception_Handlers (Handled_Statement_Sequence (N))) then
@ -1330,7 +1342,7 @@ package body Exp_Ch7 is
(Handled_Statement_Sequence (N), Sloc (First (Declarations (N))));
-- The declarations of the _Clean procedure and finalization chain
-- replace the old declarations that have been moved inward
-- replace the old declarations that have been moved inward.
Set_Declarations (N, New_Decls);
Analyze_Declarations (New_Decls);
@ -1342,9 +1354,9 @@ package body Exp_Ch7 is
begin
-- If the construct is a protected subprogram, then the call to
-- the corresponding unprotected program appears in a block which
-- is the last statement in the body, and it is this block that
-- must be covered by the At_End handler.
-- the corresponding unprotected subprogram appears in a block which
-- is the last statement in the body, and it is this block that must
-- be covered by the At_End handler.
if Is_Protected then
HSS := Handled_Statement_Sequence
@ -1353,6 +1365,10 @@ package body Exp_Ch7 is
HSS := Handled_Statement_Sequence (N);
end if;
-- Never overwrite an existing AT END call
pragma Assert (No (At_End_Proc (HSS)));
Set_At_End_Proc (HSS, New_Occurrence_Of (Clean, Loc));
Expand_At_End_Handler (HSS, Empty);
end;
@ -1708,10 +1724,16 @@ package body Exp_Ch7 is
R : Node_Id;
begin
-- If the restriction No_Finalization applies, then there's not any
-- finalization list available to return, so return Empty.
if Restriction_Active (No_Finalization) then
return Empty;
-- Case of an internal component. The Final list is the record
-- controller of the enclosing record.
if Present (Ref) then
elsif Present (Ref) then
R := Ref;
loop
case Nkind (R) is
@ -1741,10 +1763,13 @@ package body Exp_Ch7 is
Selector_Name => Make_Identifier (Loc, Name_uController)),
Selector_Name => Make_Identifier (Loc, Name_F));
-- Case of a dynamically allocated object. The final list is the
-- corresponding list controller (the next entity in the scope of the
-- access type with the right type). If the type comes from a With_Type
-- clause, no controller was created, we use the global chain instead.
-- Case of a dynamically allocated object whose access type has an
-- Associated_Final_Chain. The final list is the corresponding list
-- controller (the next entity in the scope of the access type with
-- the right type). If the type comes from a With_Type clause, no
-- controller was created, we use the global chain instead. (The code
-- related to with_type clauses should presumably be removed at some
-- point since that feature is obsolete???)
-- An anonymous access type either has a list created for it when the
-- allocator is a for an access parameter or an access discriminant,
@ -1752,19 +1777,21 @@ package body Exp_Ch7 is
-- context is a declaration or an assignment.
elsif Is_Access_Type (E)
and then (Ekind (E) /= E_Anonymous_Access_Type
or else
Present (Associated_Final_Chain (E)))
and then (Present (Associated_Final_Chain (E))
or else From_With_Type (E))
then
if not From_With_Type (E) then
if From_With_Type (E) then
return New_Reference_To (RTE (RE_Global_Final_List), Sloc (E));
-- Use the access type's associated finalization chain
else
return
Make_Selected_Component (Loc,
Prefix =>
New_Reference_To
(Associated_Final_Chain (Base_Type (E)), Loc),
Selector_Name => Make_Identifier (Loc, Name_F));
else
return New_Reference_To (RTE (RE_Global_Final_List), Sloc (E));
end if;
else
@ -2233,7 +2260,8 @@ package body Exp_Ch7 is
Is_Master : Boolean;
Is_Protected_Subprogram : Boolean;
Is_Task_Allocation_Block : Boolean;
Is_Asynchronous_Call_Block : Boolean) return Node_Id
Is_Asynchronous_Call_Block : Boolean;
Chained_Cleanup_Action : Node_Id) return Node_Id
is
Loc : constant Source_Ptr := Sloc (Clean);
Stmt : constant List_Id := New_List;
@ -2476,6 +2504,12 @@ package body Exp_Ch7 is
New_Reference_To (Mark, Loc))));
end if;
if Present (Chained_Cleanup_Action) then
Append_To (Stmt,
Make_Procedure_Call_Statement (Loc,
Name => Chained_Cleanup_Action));
end if;
Sbody :=
Make_Subprogram_Body (Loc,
Specification =>
@ -3372,13 +3406,14 @@ package body Exp_Ch7 is
Insert_List_Before_And_Analyze (First (List_Containing (N)), Nodes);
-- Generate the Finalization calls by finalizing the list
-- controller right away. It will be re-finalized on scope
-- exit but it doesn't matter. It cannot be done when the
-- call initializes a renaming object though because in this
-- case, the object becomes a pointer to the temporary and thus
-- increases its life span. Ditto if this is a renaming of a
-- component of an expression (such as a function call). .
-- Generate the Finalization calls by finalizing the list controller
-- right away. It will be re-finalized on scope exit but it doesn't
-- matter. It cannot be done when the call initializes a renaming
-- object though because in this case, the object becomes a pointer
-- to the temporary and thus increases its life span. Ditto if this
-- is a renaming of a component of an expression (such as a function
-- call).
-- Note that there is a problem if an actual in the call needs
-- finalization, because in that case the call itself is the master,
-- and the actual should be finalized on return from the call ???