[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

diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index 3712fe1ce7d257374bf067bbb0d069e268bcac5c..acda7cfc691374d8fbe65ca2040c8229409f2325 100644 (file)
--- 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 0356b67e6c69fc85b789db9605aaa63007c802cc..ad65378cffb600d26c33c18d6f554f1dd2e80403 100644 (file)
--- 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 a897b13f913185c584bbcf5ea30eb4df8b301fcb..9229610554fc8bf4e2d9f7492c8d0afc8cb3ab52 100644 (file)
--- 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 ca7310585b4f388ab30c546ca0b9a1f9a58db9a0..9a76e04adf61f39b2ad3ce1505ed829b87ecf692 100644 (file)
--- 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