[multiple changes]
2013-10-17 Yannick Moy <moy@adacore.com> * sem_res.adb (Resolve_Short_Circuit): Only generate expression-with-action when full expansion is set. 2013-10-17 Yannick Moy <moy@adacore.com> * debug.adb Remove obsolete comment. 2013-10-17 Thomas Quinot <quinot@adacore.com> * exp_ch4.adb (Process_Transient_Object.Find_Enclosing_Contexts): Avoid late insertion when expanding an expression with action nested within a transient block; Do not inconditionally generate a finalization call if the generated object is from a specific branch of a conditional expression. 2013-10-17 Pascal Obry <obry@adacore.com> * g-arrspl.adb: Ensure Finalize call is idempotent. * g-arrspl.adb (Finalize): Makes the call idempotent. From-SVN: r203768
This commit is contained in:
Arnaud Charlet
parent
a9895094b3
commit
a7d08a3844
4 changed files with 54 additions and 40 deletions
|
|
@ -665,10 +665,6 @@ package body Debug is
|
|||
-- the order in which units are walked. This is primarily for use in
|
||||
-- debugging CodePeer mode.
|
||||
|
||||
-- d.Y Prevents the use of the N_Expression_With_Actions node even in the
|
||||
-- case of the gcc back end. Provided as a back up in case the new
|
||||
-- scheme has problems.
|
||||
|
||||
-- d1 Error messages have node numbers where possible. Normally error
|
||||
-- messages have only source locations. This option is useful when
|
||||
-- debugging errors caused by expanded code, where the source location
|
||||
|
|
|
|||
|
|
@ -12158,23 +12158,21 @@ package body Exp_Ch4 is
|
|||
Par : Node_Id;
|
||||
Top : Node_Id;
|
||||
|
||||
Wrapped_Node : Node_Id;
|
||||
-- Note: if we are in a transient scope, we want to reuse it as
|
||||
-- the context for actions insertion, if possible. But if N is itself
|
||||
-- part of the stored actions for the current transient scope,
|
||||
-- then we need to insert at the appropriate (inner) location in
|
||||
-- the not as an action on Node_To_Be_Wrapped.
|
||||
|
||||
In_Cond_Expr : constant Boolean := Within_Case_Or_If_Expression (N);
|
||||
|
||||
begin
|
||||
-- In most cases an expression that creates a controlled object
|
||||
-- generates a transient scope around it. If this is the case then
|
||||
-- other controlled values can reuse it.
|
||||
|
||||
if Scope_Is_Transient then
|
||||
Hook_Context := Node_To_Be_Wrapped;
|
||||
|
||||
-- In some cases, such as return statements, no transient scope is
|
||||
-- generated, in which case we have to look up in the tree to find
|
||||
-- the proper list on which to place the transient.
|
||||
|
||||
-- When the node is inside a case/if expression, the lifetime of any
|
||||
-- temporary controlled object is extended. Find a suitable insertion
|
||||
-- node by locating the topmost case or if expressions.
|
||||
|
||||
elsif Within_Case_Or_If_Expression (N) then
|
||||
if In_Cond_Expr then
|
||||
Par := N;
|
||||
Top := N;
|
||||
while Present (Par) loop
|
||||
|
|
@ -12256,8 +12254,16 @@ package body Exp_Ch4 is
|
|||
|
||||
-- Proc (... and then Ctrl_Func_Call ...);
|
||||
|
||||
if Scope_Is_Transient then
|
||||
Wrapped_Node := Node_To_Be_Wrapped;
|
||||
else
|
||||
Wrapped_Node := Empty;
|
||||
end if;
|
||||
|
||||
while Present (Par) loop
|
||||
if Nkind_In (Par, N_Assignment_Statement,
|
||||
if Par = Wrapped_Node
|
||||
or else
|
||||
Nkind_In (Par, N_Assignment_Statement,
|
||||
N_Object_Declaration,
|
||||
N_Pragma,
|
||||
N_Procedure_Call_Statement,
|
||||
|
|
@ -12292,9 +12298,14 @@ package body Exp_Ch4 is
|
|||
-- In this case, the finalization context is chosen so that
|
||||
-- we know at finalization point that the hook pointer is
|
||||
-- never null, so no need for a test, we can call the finalizer
|
||||
-- unconditionally.
|
||||
-- unconditionally, except in the case where the object is
|
||||
-- created in a specific branch of a conditional expression.
|
||||
|
||||
Finalize_Always := True;
|
||||
Finalize_Always :=
|
||||
not (In_Cond_Expr
|
||||
or else
|
||||
Nkind_In (Original_Node (N), N_Case_Expression,
|
||||
N_If_Expression));
|
||||
|
||||
declare
|
||||
Loc : constant Source_Ptr := Sloc (N);
|
||||
|
|
@ -12382,6 +12393,13 @@ package body Exp_Ch4 is
|
|||
|
||||
-- Step 3: Hook the transient object to the temporary
|
||||
|
||||
-- This must be inserted right after the object declaration, so that
|
||||
-- the assignment is executed if, and only if, the object is actually
|
||||
-- created (whereas the declaration of the hook pointer, and the
|
||||
-- finalization call, may be inserted at an outer level, and may
|
||||
-- remain unused for some executions, if the actual creation of
|
||||
-- the object is conditional).
|
||||
|
||||
-- The use of unchecked conversion / unrestricted access is needed to
|
||||
-- avoid an accessibility violation. Note that the finalization code is
|
||||
-- structured in such a way that the "hook" is processed only when it
|
||||
|
|
@ -12401,18 +12419,10 @@ package body Exp_Ch4 is
|
|||
-- <or>
|
||||
-- Temp := Obj_Id'Unrestricted_Access;
|
||||
|
||||
if Finalization_Context /= Hook_Context then
|
||||
Insert_Action (Finalization_Context,
|
||||
Make_Assignment_Statement (Loc,
|
||||
Name => New_Reference_To (Temp_Id, Loc),
|
||||
Expression => Expr));
|
||||
|
||||
else
|
||||
Insert_After_And_Analyze (Decl,
|
||||
Make_Assignment_Statement (Loc,
|
||||
Name => New_Reference_To (Temp_Id, Loc),
|
||||
Expression => Expr));
|
||||
end if;
|
||||
Insert_After_And_Analyze (Decl,
|
||||
Make_Assignment_Statement (Loc,
|
||||
Name => New_Reference_To (Temp_Id, Loc),
|
||||
Expression => Expr));
|
||||
|
||||
-- Step 4: Finalize the transient controlled object after the context
|
||||
-- has been evaluated/elaborated. Generate:
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2002-2009, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2002-2013, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
|
|
@ -118,14 +118,22 @@ package body GNAT.Array_Split is
|
|||
procedure Free is
|
||||
new Ada.Unchecked_Deallocation (Natural, Counter);
|
||||
|
||||
begin
|
||||
S.Ref_Counter.all := S.Ref_Counter.all - 1;
|
||||
Ref_Counter : Counter := S.Ref_Counter;
|
||||
|
||||
if S.Ref_Counter.all = 0 then
|
||||
Free (S.Source);
|
||||
Free (S.Indexes);
|
||||
Free (S.Slices);
|
||||
Free (S.Ref_Counter);
|
||||
begin
|
||||
-- Ensure call is idempotent
|
||||
|
||||
S.Ref_Counter := null;
|
||||
|
||||
if Ref_Counter /= null then
|
||||
Ref_Counter.all := Ref_Counter.all - 1;
|
||||
|
||||
if Ref_Counter.all = 0 then
|
||||
Free (S.Source);
|
||||
Free (S.Indexes);
|
||||
Free (S.Slices);
|
||||
Free (Ref_Counter);
|
||||
end if;
|
||||
end if;
|
||||
end Finalize;
|
||||
|
||||
|
|
|
|||
|
|
@ -9022,7 +9022,7 @@ package body Sem_Res is
|
|||
-- helpful for coverage analysis. However this should not happen in
|
||||
-- generics.
|
||||
|
||||
if Expander_Active then
|
||||
if Full_Expander_Active then
|
||||
declare
|
||||
Reloc_L : constant Node_Id := Relocate_Node (L);
|
||||
begin
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue