diff options
| -rw-r--r-- | gcc/ada/debug.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/exp_ch4.adb | 62 | ||||
| -rw-r--r-- | gcc/ada/g-arrspl.adb | 22 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 2 |
4 files changed, 52 insertions, 38 deletions
diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 3712fe1ce7d..acda7cfc691 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -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 diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 0356b67e6c6..ad65378cffb 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -12158,23 +12158,21 @@ package body Exp_Ch4 is Par : Node_Id; Top : Node_Id; - 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; + 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 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. + In_Cond_Expr : constant Boolean := Within_Case_Or_If_Expression (N); + begin -- 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: diff --git a/gcc/ada/g-arrspl.adb b/gcc/ada/g-arrspl.adb index a897b13f913..9229610554f 100644 --- a/gcc/ada/g-arrspl.adb +++ b/gcc/ada/g-arrspl.adb @@ -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); + Ref_Counter : Counter := S.Ref_Counter; + begin - S.Ref_Counter.all := S.Ref_Counter.all - 1; + -- Ensure call is idempotent + + S.Ref_Counter := null; - if S.Ref_Counter.all = 0 then - Free (S.Source); - Free (S.Indexes); - Free (S.Slices); - Free (S.Ref_Counter); + 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; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index ca7310585b4..9a76e04adf6 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -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 |
