2013-07-08 Hristian Kirtchev <kirtchev@adacore.com>

	* exp_ch4.adb (Create_Alternative): Removed.
	(Expand_N_If_Expression): Remove constant
	In_Case_Or_If_Expression. Add local variable
	Ptr_Typ. Inspect the "then" and "else" action lists
	for transient controlled objects and generate code to
	finalize them.	(Is_Controlled_Function_Call): Removed.
	(Process_Action): Update the comment on usage. Update the call
	to Process_Transient_Object. There is no need to continue the
	traversal of the object itself.
	(Process_Actions): New routine.
	(Process_Transient_Object): Moved to the top level of Exp_Ch4. Add
	a new formal and update the related comment on usage.
	* exp_util.adb (Within_Case_Or_If_Expression): Start the search
	from the parent of the node.

2013-07-08  Robert Dewar  <dewar@adacore.com>

	* a-cusyqu.ads, a-cbprqu.ads, s-interr.ads, a-cuprqu.ads,
	a-cbsyqu.ads: Minor reformatting (proper formatting of overriding).



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@200759 138bc75d-0d04-0410-961f-82ee72b054a4

8 files changed, 435 insertions, 467 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 9f72a459e92..8d8c993ffbd 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,25 @@
+2013-07-08  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch4.adb (Create_Alternative): Removed.
+	(Expand_N_If_Expression): Remove constant
+	In_Case_Or_If_Expression. Add local variable
+	Ptr_Typ. Inspect the "then" and "else" action lists
+	for transient controlled objects and generate code to
+	finalize them.	(Is_Controlled_Function_Call): Removed.
+	(Process_Action): Update the comment on usage. Update the call
+	to Process_Transient_Object. There is no need to continue the
+	traversal of the object itself.
+	(Process_Actions): New routine.
+	(Process_Transient_Object): Moved to the top level of Exp_Ch4. Add
+	a new formal and update the related comment on usage.
+	* exp_util.adb (Within_Case_Or_If_Expression): Start the search
+	from the parent of the node.
+
+2013-07-08  Robert Dewar  <dewar@adacore.com>
+
+	* a-cusyqu.ads, a-cbprqu.ads, s-interr.ads, a-cuprqu.ads,
+	a-cbsyqu.ads: Minor reformatting (proper formatting of overriding).
+
 2013-07-08  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_ch8.adb (Attribute_Renaming): Treat 'Img as an attribute
diff --git a/gcc/ada/a-cbprqu.ads b/gcc/ada/a-cbprqu.ads
index aa184a1cc5a..fb44d02c1dd 100644
--- a/gcc/ada/a-cbprqu.ads
+++ b/gcc/ada/a-cbprqu.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---            Copyright (C) 2011, Free Software Foundation, Inc.            --
+--          Copyright (C) 2011-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -101,13 +101,13 @@ package Ada.Containers.Bounded_Priority_Queues is
    protected type Queue
      (Capacity : Count_Type := Default_Capacity;
       Ceiling  : System.Any_Priority := Default_Ceiling)
-     with Priority => Ceiling is new Queue_Interfaces.Queue with
+   with
+     Priority => Ceiling
+   is new Queue_Interfaces.Queue with
 
-      overriding
-      entry Enqueue (New_Item : Queue_Interfaces.Element_Type);
+      overriding entry Enqueue (New_Item : Queue_Interfaces.Element_Type);
 
-      overriding
-      entry Dequeue (Element : out Queue_Interfaces.Element_Type);
+      overriding entry Dequeue (Element : out Queue_Interfaces.Element_Type);
 
       --  The priority queue operation Dequeue_Only_High_Priority had been a
       --  protected entry in early drafts of AI05-0159, but it was discovered
@@ -116,22 +116,17 @@ package Ada.Containers.Bounded_Priority_Queues is
       --  ARG meeting in Edinburgh (June 2011), with a different signature and
       --  semantics.
 
-      not overriding
       procedure Dequeue_Only_High_Priority
         (At_Least : Queue_Priority;
          Element  : in out Queue_Interfaces.Element_Type;
          Success  : out Boolean);
 
-      overriding
-      function Current_Use return Count_Type;
+      overriding function Current_Use return Count_Type;
 
-      overriding
-      function Peak_Use return Count_Type;
+      overriding function Peak_Use return Count_Type;
 
    private
-
       List : Implementation.List_Type (Capacity);
-
    end Queue;
 
 end Ada.Containers.Bounded_Priority_Queues;
diff --git a/gcc/ada/a-cbsyqu.ads b/gcc/ada/a-cbsyqu.ads
index 0d6e3c39958..908463906ce 100644
--- a/gcc/ada/a-cbsyqu.ads
+++ b/gcc/ada/a-cbsyqu.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---            Copyright (C) 2011, Free Software Foundation, Inc.            --
+--          Copyright (C) 2011-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -83,24 +83,20 @@ package Ada.Containers.Bounded_Synchronized_Queues is
    protected type Queue
      (Capacity : Count_Type := Default_Capacity;
       Ceiling  : System.Any_Priority := Default_Ceiling)
-     with Priority => Ceiling is new Queue_Interfaces.Queue with
+   with
+     Priority => Ceiling
+   is new Queue_Interfaces.Queue with
 
-      overriding
-      entry Enqueue (New_Item : Queue_Interfaces.Element_Type);
+      overriding entry Enqueue (New_Item : Queue_Interfaces.Element_Type);
 
-      overriding
-      entry Dequeue (Element : out Queue_Interfaces.Element_Type);
+      overriding entry Dequeue (Element : out Queue_Interfaces.Element_Type);
 
-      overriding
-      function Current_Use return Count_Type;
+      overriding function Current_Use return Count_Type;
 
-      overriding
-      function Peak_Use return Count_Type;
+      overriding function Peak_Use return Count_Type;
 
    private
-
       List : Implementation.List_Type (Capacity);
-
    end Queue;
 
 end Ada.Containers.Bounded_Synchronized_Queues;
diff --git a/gcc/ada/a-cuprqu.ads b/gcc/ada/a-cuprqu.ads
index 3709f42aa29..4e11d6eef05 100644
--- a/gcc/ada/a-cuprqu.ads
+++ b/gcc/ada/a-cuprqu.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---            Copyright (C) 2011, Free Software Foundation, Inc.            --
+--          Copyright (C) 2011-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -94,19 +94,18 @@ package Ada.Containers.Unbounded_Priority_Queues is
          Max_Length  : Count_Type := 0;
       end record;
 
-      overriding
-      procedure Finalize (List : in out List_Type);
+      overriding procedure Finalize (List : in out List_Type);
 
    end Implementation;
 
    protected type Queue (Ceiling : System.Any_Priority := Default_Ceiling)
-     with Priority => Ceiling is new Queue_Interfaces.Queue with
+   with
+     Priority => Ceiling
+   is new Queue_Interfaces.Queue with
 
-      overriding
-      entry Enqueue (New_Item : Queue_Interfaces.Element_Type);
+      overriding entry Enqueue (New_Item : Queue_Interfaces.Element_Type);
 
-      overriding
-      entry Dequeue (Element : out Queue_Interfaces.Element_Type);
+      overriding entry Dequeue (Element : out Queue_Interfaces.Element_Type);
 
       --  The priority queue operation Dequeue_Only_High_Priority had been a
       --  protected entry in early drafts of AI05-0159, but it was discovered
@@ -115,22 +114,17 @@ package Ada.Containers.Unbounded_Priority_Queues is
       --  ARG meeting in Edinburgh (June 2011), with a different signature and
       --  semantics.
 
-      not overriding
       procedure Dequeue_Only_High_Priority
         (At_Least : Queue_Priority;
          Element  : in out Queue_Interfaces.Element_Type;
          Success  : out Boolean);
 
-      overriding
-      function Current_Use return Count_Type;
+      overriding function Current_Use return Count_Type;
 
-      overriding
-      function Peak_Use return Count_Type;
+      overriding function Peak_Use return Count_Type;
 
    private
-
       List : Implementation.List_Type;
-
    end Queue;
 
 end Ada.Containers.Unbounded_Priority_Queues;
diff --git a/gcc/ada/a-cusyqu.ads b/gcc/ada/a-cusyqu.ads
index c4f9d7f7d59..c4f18020356 100644
--- a/gcc/ada/a-cusyqu.ads
+++ b/gcc/ada/a-cusyqu.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---            Copyright (C) 2011, Free Software Foundation, Inc.            --
+--          Copyright (C) 2011-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -80,30 +80,26 @@ package Ada.Containers.Unbounded_Synchronized_Queues is
          Max_Length  : Count_Type := 0;
       end record;
 
-      overriding
-      procedure Finalize (List : in out List_Type);
+      overriding procedure Finalize (List : in out List_Type);
 
    end Implementation;
 
-   protected type Queue (Ceiling : System.Any_Priority := Default_Ceiling)
-     with Priority => Ceiling is new Queue_Interfaces.Queue with
+   protected type Queue
+     (Ceiling : System.Any_Priority := Default_Ceiling)
+   with
+     Priority => Ceiling
+   is new Queue_Interfaces.Queue with
 
-      overriding
-      entry Enqueue (New_Item : Queue_Interfaces.Element_Type);
+      overriding entry Enqueue (New_Item : Queue_Interfaces.Element_Type);
 
-      overriding
-      entry Dequeue (Element : out Queue_Interfaces.Element_Type);
+      overriding entry Dequeue (Element : out Queue_Interfaces.Element_Type);
 
-      overriding
-      function Current_Use return Count_Type;
+      overriding function Current_Use return Count_Type;
 
-      overriding
-      function Peak_Use return Count_Type;
+      overriding function Peak_Use return Count_Type;
 
    private
-
       List : Implementation.List_Type;
-
    end Queue;
 
 end Ada.Containers.Unbounded_Synchronized_Queues;
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index f9c6fd81f7b..26c517678f5 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -233,6 +233,16 @@ package body Exp_Ch4 is
    --  simple entity, and op is a comparison operator, optimizes it into a
    --  comparison of First and Last.
 
+   procedure Process_Transient_Object
+     (Decl     : Node_Id;
+      Rel_Node : Node_Id);
+   --  Subsidiary routine to the expansion of expression_with_actions and if
+   --  expressions. Generate all the necessary code to finalize a transient
+   --  controlled object when the enclosing context is elaborated or evaluated.
+   --  Decl denotes the declaration of the transient controlled object which is
+   --  usually the result of a controlled function call. Rel_Node denotes the
+   --  context, either an expression_with_actions or an if expression.
+
    procedure Rewrite_Comparison (N : Node_Id);
    --  If N is the node for a comparison whose outcome can be determined at
    --  compile time, then the node N can be rewritten with True or False. If
@@ -5052,306 +5062,23 @@ package body Exp_Ch4 is
    --------------------------------------
 
    procedure Expand_N_Expression_With_Actions (N : Node_Id) is
-      In_Case_Or_If_Expression : constant Boolean :=
-                                   Within_Case_Or_If_Expression (N);
-
       function Process_Action (Act : Node_Id) return Traverse_Result;
-      --  Inspect and process a single action of an expression_with_actions
+      --  Inspect and process a single action of an expression_with_actions for
+      --  transient controlled objects. If such objects are found, the routine
+      --  generates code to clean them up when the context of the expression is
+      --  evaluated or elaborated.
 
       --------------------
       -- Process_Action --
       --------------------
 
       function Process_Action (Act : Node_Id) return Traverse_Result is
-         procedure Process_Transient_Object (Obj_Decl : Node_Id);
-         --  Obj_Decl denotes the declaration of a transient controlled object.
-         --  Generate all necessary types and hooks to properly finalize the
-         --  result when the enclosing context is elaborated/evaluated.
-
-         ------------------------------
-         -- Process_Transient_Object --
-         ------------------------------
-
-         procedure Process_Transient_Object (Obj_Decl : Node_Id) is
-            function Find_Enclosing_Context return Node_Id;
-            --  Find the context where the expression_with_actions appears
-
-            ----------------------------
-            -- Find_Enclosing_Context --
-            ----------------------------
-
-            function Find_Enclosing_Context return Node_Id is
-               Par : Node_Id;
-               Top : Node_Id;
-
-            begin
-               --  The expression_with_actions is in a case/if expression and
-               --  the lifetime of any temporary controlled object is therefore
-               --  extended. Find a suitable insertion node by locating the top
-               --  most case or if expressions.
-
-               if In_Case_Or_If_Expression then
-                  Par := N;
-                  Top := N;
-                  while Present (Par) loop
-                     if Nkind_In (Original_Node (Par), N_Case_Expression,
-                                                       N_If_Expression)
-                     then
-                        Top := Par;
-
-                     --  Prevent the search from going too far
-
-                     elsif Is_Body_Or_Package_Declaration (Par) then
-                        exit;
-                     end if;
-
-                     Par := Parent (Par);
-                  end loop;
-
-                  --  The topmost case or if expression is now recovered, but
-                  --  it may still not be the correct place to add all the
-                  --  generated code. Climb to find a parent that is part of a
-                  --  declarative or statement list.
-
-                  Par := Top;
-                  while Present (Par) loop
-                     if Is_List_Member (Par)
-                       and then
-                         not Nkind_In (Par, N_Component_Association,
-                                            N_Discriminant_Association,
-                                            N_Parameter_Association,
-                                            N_Pragma_Argument_Association)
-                     then
-                        return Par;
-
-                     --  Prevent the search from going too far
-
-                     elsif Is_Body_Or_Package_Declaration (Par) then
-                        exit;
-                     end if;
-
-                     Par := Parent (Par);
-                  end loop;
-
-                  return Par;
-
-               --  Short circuit operators in complex expressions are converted
-               --  into expression_with_actions.
-
-               else
-                  --  Take care of the case where the expression_with_actions
-                  --  is buried deep inside an IF statement. The temporary
-                  --  function result must be finalized before the then, elsif
-                  --  or else statements are evaluated.
-
-                  --    if Something
-                  --      and then Ctrl_Func_Call
-                  --    then
-                  --       <result must be finalized at this point>
-                  --       <statements>
-                  --    end if;
-
-                  --  To achieve this, find the topmost logical operator. The
-                  --  generated actions are then inserted before/after it.
-
-                  Par := N;
-                  while Present (Par) loop
-
-                     --  Keep climbing past various operators
-
-                     if Nkind (Parent (Par)) in N_Op
-                       or else Nkind_In (Parent (Par), N_And_Then, N_Or_Else)
-                     then
-                        Par := Parent (Par);
-                     else
-                        exit;
-                     end if;
-                  end loop;
-
-                  Top := Par;
-
-                  --  The expression_with_actions might be located in a pragma
-                  --  in which case locate the pragma itself:
-
-                  --    pragma Precondition (... and then Ctrl_Func_Call ...);
-
-                  --  Similar case occurs when the expression_with_actions is
-                  --  related to an object declaration or assignment:
-
-                  --    Obj [: Some_Typ] := ... and then Ctrl_Func_Call ...;
-
-                  --  Another case to consider is an expression_with_actions as
-                  --  part of a return statement:
-
-                  --    return ... and then Ctrl_Func_Call ...;
-
-                  --  Yet another case: a formal in a procedure call statement:
-
-                  --    Proc (... and then Ctrl_Func_Call ...);
-
-                  while Present (Par) loop
-                     if Nkind_In (Par, N_Assignment_Statement,
-                                       N_Object_Declaration,
-                                       N_Pragma,
-                                       N_Procedure_Call_Statement,
-                                       N_Simple_Return_Statement)
-                     then
-                        return Par;
-
-                     --  Prevent the search from going too far
-
-                     elsif Is_Body_Or_Package_Declaration (Par) then
-                        exit;
-                     end if;
-
-                     Par := Parent (Par);
-                  end loop;
-
-                  --  Return the topmost short circuit operator
-
-                  return Top;
-               end if;
-            end Find_Enclosing_Context;
-
-            --  Local variables
-
-            Context   : constant Node_Id    := Find_Enclosing_Context;
-            Loc       : constant Source_Ptr := Sloc (Obj_Decl);
-            Obj_Id    : constant Entity_Id  := Defining_Identifier (Obj_Decl);
-            Obj_Typ   : constant Node_Id    := Etype (Obj_Id);
-            Desig_Typ : Entity_Id;
-            Expr      : Node_Id;
-            Fin_Call  : Node_Id;
-            Ptr_Id    : Entity_Id;
-            Temp_Id   : Entity_Id;
-
-         --  Start of processing for Process_Transient_Object
-
-         begin
-            --  Step 1: Create the access type which provides a reference to
-            --  the transient object.
-
-            if Is_Access_Type (Obj_Typ) then
-               Desig_Typ := Directly_Designated_Type (Obj_Typ);
-            else
-               Desig_Typ := Obj_Typ;
-            end if;
-
-            Desig_Typ := Base_Type (Desig_Typ);
-
-            --  Generate:
-            --    Ann : access [all] <Desig_Typ>;
-
-            Ptr_Id := Make_Temporary (Loc, 'A');
-
-            Insert_Action (Context,
-              Make_Full_Type_Declaration (Loc,
-                Defining_Identifier => Ptr_Id,
-                Type_Definition     =>
-                  Make_Access_To_Object_Definition (Loc,
-                    All_Present        =>
-                      Ekind (Obj_Typ) = E_General_Access_Type,
-                    Subtype_Indication => New_Reference_To (Desig_Typ, Loc))));
-
-            --  Step 2: Create a temporary which acts as a hook to the
-            --  transient object. Generate:
-
-            --    Temp : Ptr_Id := null;
-
-            Temp_Id := Make_Temporary (Loc, 'T');
-
-            Insert_Action (Context,
-              Make_Object_Declaration (Loc,
-                Defining_Identifier => Temp_Id,
-                Object_Definition   => New_Reference_To (Ptr_Id, Loc)));
-
-            --  Mark this temporary as created for the purposes of exporting
-            --  the transient declaration out of the Actions list. This signals
-            --  the machinery in Build_Finalizer to recognize this special
-            --  case.
-
-            Set_Status_Flag_Or_Transient_Decl (Temp_Id, Obj_Decl);
-
-            --  Step 3: Hook the transient object to the temporary
-
-            --  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 points to an existing object.
-
-            if Is_Access_Type (Obj_Typ) then
-               Expr :=
-                 Unchecked_Convert_To (Ptr_Id, New_Reference_To (Obj_Id, Loc));
-            else
-               Expr :=
-                 Make_Attribute_Reference (Loc,
-                   Prefix         => New_Reference_To (Obj_Id, Loc),
-                   Attribute_Name => Name_Unrestricted_Access);
-            end if;
-
-            --  Generate:
-            --    Temp := Ptr_Id (Obj_Id);
-            --      <or>
-            --    Temp := Obj_Id'Unrestricted_Access;
-
-            Insert_After_And_Analyze (Obj_Decl,
-              Make_Assignment_Statement (Loc,
-                Name       => New_Reference_To (Temp_Id, Loc),
-                Expression => Expr));
-
-            --  Step 4: Finalize the function result after the context has been
-            --  evaluated/elaborated. Generate:
-
-            --    if Temp /= null then
-            --       [Deep_]Finalize (Temp.all);
-            --       Temp := null;
-            --    end if;
-
-            --  When the expression_with_actions is part of a return statement,
-            --  there is no need to insert a finalization call, as the general
-            --  finalization mechanism (see Build_Finalizer) would take care of
-            --  the temporary function result on subprogram exit. Note that it
-            --  would also be impossible to insert the finalization code after
-            --  the return statement as this would make it unreachable.
-
-            if Nkind (Context) /= N_Simple_Return_Statement then
-               Fin_Call :=
-                 Make_Implicit_If_Statement (Obj_Decl,
-                   Condition =>
-                     Make_Op_Ne (Loc,
-                       Left_Opnd  => New_Reference_To (Temp_Id, Loc),
-                       Right_Opnd => Make_Null (Loc)),
-
-                   Then_Statements => New_List (
-                     Make_Final_Call
-                       (Obj_Ref =>
-                          Make_Explicit_Dereference (Loc,
-                            Prefix => New_Reference_To (Temp_Id, Loc)),
-                        Typ     => Desig_Typ),
-
-                     Make_Assignment_Statement (Loc,
-                       Name       => New_Reference_To (Temp_Id, Loc),
-                       Expression => Make_Null (Loc))));
-
-               --  Use the Actions list of logical operators when inserting the
-               --  finalization call. This ensures that all transient objects
-               --  are finalized after the operators are evaluated.
-
-               if Nkind_In (Context, N_And_Then, N_Or_Else) then
-                  Insert_Action (Context, Fin_Call);
-               else
-                  Insert_Action_After (Context, Fin_Call);
-               end if;
-            end if;
-         end Process_Transient_Object;
-
-      --  Start of processing for Process_Action
-
       begin
          if Nkind (Act) = N_Object_Declaration
            and then Is_Finalizable_Transient (Act, N)
          then
-            Process_Transient_Object (Act);
+            Process_Transient_Object (Act, N);
+            return Abandon;
 
          --  Avoid processing temporary function results multiple times when
          --  dealing with nested expression_with_actions.
@@ -5359,8 +5086,8 @@ package body Exp_Ch4 is
          elsif Nkind (Act) = N_Expression_With_Actions then
             return Abandon;
 
-         --  Do not process temporary function results in loops. This is
-         --  done by Expand_N_Loop_Statement and Build_Finalizer.
+         --  Do not process temporary function results in loops. This is done
+         --  by Expand_N_Loop_Statement and Build_Finalizer.
 
          elsif Nkind (Act) = N_Loop_Statement then
             return Abandon;
@@ -5393,67 +5120,31 @@ package body Exp_Ch4 is
    --  Deal with limited types and condition actions
 
    procedure Expand_N_If_Expression (N : Node_Id) is
-      function Create_Alternative
-        (Loc     : Source_Ptr;
-         Temp_Id : Entity_Id;
-         Flag_Id : Entity_Id;
-         Expr    : Node_Id) return List_Id;
-      --  Build the statements of a "then" or "else" dependent expression
-      --  alternative. Temp_Id is the if expression result, Flag_Id is a
-      --  finalization flag created to service expression Expr.
-
-      function Is_Controlled_Function_Call (Expr : Node_Id) return Boolean;
-      --  Determine if expression Expr is a rewritten controlled function call
+      procedure Process_Actions (Actions : List_Id);
+      --  Inspect and process a single action list of an if expression for
+      --  transient controlled objects. If such objects are found, the routine
+      --  generates code to clean them up when the context of the expression is
+      --  evaluated or elaborated.
 
-      ------------------------
-      -- Create_Alternative --
-      ------------------------
+      ---------------------
+      -- Process_Actions --
+      ---------------------
 
-      function Create_Alternative
-        (Loc     : Source_Ptr;
-         Temp_Id : Entity_Id;
-         Flag_Id : Entity_Id;
-         Expr    : Node_Id) return List_Id
-      is
-         Result : constant List_Id := New_List;
+      procedure Process_Actions (Actions : List_Id) is
+         Act : Node_Id;
 
       begin
-         --  Generate:
-         --    Fnn := True;
-
-         if Present (Flag_Id)
-           and then not Is_Controlled_Function_Call (Expr)
-         then
-            Append_To (Result,
-              Make_Assignment_Statement (Loc,
-                Name       => New_Reference_To (Flag_Id, Loc),
-                Expression => New_Reference_To (Standard_True, Loc)));
-         end if;
-
-         --  Generate:
-         --    Cnn := <expr>'Unrestricted_Access;
-
-         Append_To (Result,
-           Make_Assignment_Statement (Loc,
-             Name       => New_Reference_To (Temp_Id, Loc),
-             Expression =>
-               Make_Attribute_Reference (Loc,
-                 Prefix         => Relocate_Node (Expr),
-                 Attribute_Name => Name_Unrestricted_Access)));
-
-         return Result;
-      end Create_Alternative;
-
-      ---------------------------------
-      -- Is_Controlled_Function_Call --
-      ---------------------------------
+         Act := First (Actions);
+         while Present (Act) loop
+            if Nkind (Act) = N_Object_Declaration
+              and then Is_Finalizable_Transient (Act, N)
+            then
+               Process_Transient_Object (Act, N);
+            end if;
 
-      function Is_Controlled_Function_Call (Expr : Node_Id) return Boolean is
-      begin
-         return
-           Nkind (Original_Node (Expr)) = N_Function_Call
-             and then Needs_Finalization (Etype (Expr));
-      end Is_Controlled_Function_Call;
+            Next (Act);
+         end loop;
+      end Process_Actions;
 
       --  Local variables
 
@@ -5469,6 +5160,7 @@ package body Exp_Ch4 is
       Expr    : Node_Id;
       New_If  : Node_Id;
       New_N   : Node_Id;
+      Ptr_Typ : Entity_Id;
 
    --  Start of processing for Expand_N_If_Expression
 
@@ -5541,70 +5233,66 @@ package body Exp_Ch4 is
       if Is_By_Reference_Type (Typ)
         and then not Back_End_Handles_Limited_Types
       then
-         declare
-            Flag_Id : Entity_Id;
-            Ptr_Typ : Entity_Id;
+         --  When the "then" or "else" expressions involve controlled function
+         --  calls, generated temporaries are chained on the corresponding list
+         --  of actions. These temporaries need to be finalized after the if
+         --  expression is evaluated.
 
-         begin
-            Flag_Id := Empty;
-
-            --  At least one of the if expression dependent expressions uses a
-            --  controlled function to provide the result. Create a status flag
-            --  to signal the finalization machinery that Cnn needs special
-            --  handling.
+         Process_Actions (Then_Actions (N));
+         Process_Actions (Else_Actions (N));
 
-            if Is_Controlled_Function_Call (Thenx)
-                 or else
-               Is_Controlled_Function_Call (Elsex)
-            then
-               Flag_Id := Make_Temporary (Loc, 'F');
+         --  Generate:
+         --    type Ann is access all Typ;
 
-               Insert_Action (N,
-                 Make_Object_Declaration (Loc,
-                   Defining_Identifier => Flag_Id,
-                   Object_Definition   =>
-                     New_Reference_To (Standard_Boolean, Loc),
-                   Expression          =>
-                     New_Reference_To (Standard_False, Loc)));
-            end if;
+         Ptr_Typ := Make_Temporary (Loc, 'A');
 
-            --  Generate:
-            --    type Ann is access all Typ;
+         Insert_Action (N,
+           Make_Full_Type_Declaration (Loc,
+             Defining_Identifier => Ptr_Typ,
+             Type_Definition     =>
+               Make_Access_To_Object_Definition (Loc,
+                 All_Present        => True,
+                 Subtype_Indication => New_Reference_To (Typ, Loc))));
 
-            Ptr_Typ := Make_Temporary (Loc, 'A');
+         --  Generate:
+         --    Cnn : Ann;
 
-            Insert_Action (N,
-              Make_Full_Type_Declaration (Loc,
-                Defining_Identifier => Ptr_Typ,
-                Type_Definition     =>
-                  Make_Access_To_Object_Definition (Loc,
-                    All_Present        => True,
-                    Subtype_Indication => New_Reference_To (Typ, Loc))));
+         Cnn := Make_Temporary (Loc, 'C', N);
 
-            --  Generate:
-            --    Cnn : Ann;
+         Decl :=
+           Make_Object_Declaration (Loc,
+             Defining_Identifier => Cnn,
+             Object_Definition   => New_Occurrence_Of (Ptr_Typ, Loc));
 
-            Cnn := Make_Temporary (Loc, 'C', N);
-            Set_Ekind (Cnn, E_Variable);
-            Set_Status_Flag_Or_Transient_Decl (Cnn, Flag_Id);
+         --  Generate:
+         --    if Cond then
+         --       Cnn := <Thenx>'Unrestricted_Access;
+         --    else
+         --       Cnn := <Elsex>'Unrestricted_Access;
+         --    end if;
 
-            Decl :=
-               Make_Object_Declaration (Loc,
-                 Defining_Identifier => Cnn,
-                 Object_Definition   => New_Occurrence_Of (Ptr_Typ, Loc));
+         New_If :=
+           Make_Implicit_If_Statement (N,
+             Condition       => Relocate_Node (Cond),
+             Then_Statements => New_List (
+               Make_Assignment_Statement (Sloc (Thenx),
+                 Name       => New_Reference_To (Cnn, Sloc (Thenx)),
+                 Expression =>
+                   Make_Attribute_Reference (Loc,
+                     Prefix         => Relocate_Node (Thenx),
+                     Attribute_Name => Name_Unrestricted_Access))),
 
-            New_If :=
-              Make_Implicit_If_Statement (N,
-                Condition       => Relocate_Node (Cond),
-                Then_Statements =>
-                  Create_Alternative (Sloc (Thenx), Cnn, Flag_Id, Thenx),
-                Else_Statements =>
-                  Create_Alternative (Sloc (Elsex), Cnn, Flag_Id, Elsex));
+             Else_Statements => New_List (
+               Make_Assignment_Statement (Sloc (Elsex),
+                 Name       => New_Reference_To (Cnn, Sloc (Elsex)),
+                 Expression =>
+                   Make_Attribute_Reference (Loc,
+                     Prefix         => Relocate_Node (Elsex),
+                     Attribute_Name => Name_Unrestricted_Access))));
 
             New_N :=
               Make_Explicit_Dereference (Loc,
                 Prefix => New_Occurrence_Of (Cnn, Loc));
-         end;
 
       --  For other types, we only need to expand if there are other actions
       --  associated with either branch.
@@ -5615,26 +5303,28 @@ package body Exp_Ch4 is
 
          if Present (Then_Actions (N)) then
             Rewrite (Thenx,
-                     Make_Expression_With_Actions (Sloc (Thenx),
-                       Actions    => Then_Actions (N),
-                       Expression => Relocate_Node (Thenx)));
+              Make_Expression_With_Actions (Sloc (Thenx),
+                Actions    => Then_Actions (N),
+                Expression => Relocate_Node (Thenx)));
+
             Set_Then_Actions (N, No_List);
             Analyze_And_Resolve (Thenx, Typ);
          end if;
 
          if Present (Else_Actions (N)) then
             Rewrite (Elsex,
-                     Make_Expression_With_Actions (Sloc (Elsex),
-                       Actions    => Else_Actions (N),
-                       Expression => Relocate_Node (Elsex)));
+              Make_Expression_With_Actions (Sloc (Elsex),
+                Actions    => Else_Actions (N),
+                Expression => Relocate_Node (Elsex)));
+
             Set_Else_Actions (N, No_List);
             Analyze_And_Resolve (Elsex, Typ);
          end if;
 
          return;
 
-         --  If no actions then no expansion needed, gigi will handle it using
-         --  the same approach as a C conditional expression.
+      --  If no actions then no expansion needed, gigi will handle it using the
+      --  same approach as a C conditional expression.
 
       else
          return;
@@ -12387,6 +12077,282 @@ package body Exp_Ch4 is
       return;
    end Optimize_Length_Comparison;
 
+   ------------------------------
+   -- Process_Transient_Object --
+   ------------------------------
+
+   procedure Process_Transient_Object
+     (Decl     : Node_Id;
+      Rel_Node : Node_Id)
+   is
+      function Find_Enclosing_Context (N : Node_Id) return Node_Id;
+      --  Find the logical context where N appears. The context is chosen such
+      --  that it is possible to insert before and after it.
+
+      ----------------------------
+      -- Find_Enclosing_Context --
+      ----------------------------
+
+      function Find_Enclosing_Context (N : Node_Id) return Node_Id is
+         Par : Node_Id;
+         Top : Node_Id;
+
+      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.
+
+         if Within_Case_Or_If_Expression (N) then
+            Par := N;
+            Top := N;
+            while Present (Par) loop
+               if Nkind_In (Original_Node (Par), N_Case_Expression,
+                                                 N_If_Expression)
+               then
+                  Top := Par;
+
+               --  Prevent the search from going too far
+
+               elsif Is_Body_Or_Package_Declaration (Par) then
+                  exit;
+               end if;
+
+               Par := Parent (Par);
+            end loop;
+
+            --  The topmost case or if expression is now recovered, but it may
+            --  still not be the correct place to add generated code. Climb to
+            --  find a parent that is part of a declarative or statement list.
+
+            Par := Top;
+            while Present (Par) loop
+               if Is_List_Member (Par)
+                 and then not Nkind_In (Par, N_Component_Association,
+                                             N_Discriminant_Association,
+                                             N_Parameter_Association,
+                                             N_Pragma_Argument_Association)
+               then
+                  return Par;
+
+               --  Prevent the search from going too far
+
+               elsif Is_Body_Or_Package_Declaration (Par) then
+                  exit;
+               end if;
+
+               Par := Parent (Par);
+            end loop;
+
+            return Par;
+
+         --  Short circuit operators in complex expressions are converted into
+         --  expression_with_actions.
+
+         else
+            --  Handle the case where the node is buried deep inside an if
+            --  statement. The temporary controlled object must be finalized
+            --  before the then, elsif or else statements are evaluated.
+
+            --    if Something
+            --      and then Ctrl_Func_Call
+            --    then
+            --       <result must be finalized at this point>
+            --       <statements>
+            --    end if;
+
+            --  To achieve this, find the topmost logical operator. Generated
+            --  actions are then inserted before/after it.
+
+            Par := N;
+            while Present (Par) loop
+
+               --  Keep climbing past various operators
+
+               if Nkind (Parent (Par)) in N_Op
+                 or else Nkind_In (Parent (Par), N_And_Then, N_Or_Else)
+               then
+                  Par := Parent (Par);
+               else
+                  exit;
+               end if;
+            end loop;
+
+            Top := Par;
+
+            --  The node may be located in a pragma in which case return the
+            --  pragma itself:
+
+            --    pragma Precondition (... and then Ctrl_Func_Call ...);
+
+            --  Similar case occurs when the node is related to an object
+            --  declaration or assignment:
+
+            --    Obj [: Some_Typ] := ... and then Ctrl_Func_Call ...;
+
+            --  Another case to consider is when the node is part of a return
+            --  statement:
+
+            --    return ... and then Ctrl_Func_Call ...;
+
+            --  Another case is when the node acts as a formal in a procedure
+            --  call statement:
+
+            --    Proc (... and then Ctrl_Func_Call ...);
+
+            while Present (Par) loop
+               if Nkind_In (Par, N_Assignment_Statement,
+                                 N_Object_Declaration,
+                                 N_Pragma,
+                                 N_Procedure_Call_Statement,
+                                 N_Simple_Return_Statement)
+               then
+                  return Par;
+
+               --  Prevent the search from going too far
+
+               elsif Is_Body_Or_Package_Declaration (Par) then
+                  exit;
+               end if;
+
+               Par := Parent (Par);
+            end loop;
+
+            --  Return the topmost short circuit operator
+
+            return Top;
+         end if;
+      end Find_Enclosing_Context;
+
+      --  Local variables
+
+      Context   : constant Node_Id    := Find_Enclosing_Context (Rel_Node);
+      Loc       : constant Source_Ptr := Sloc (Decl);
+      Obj_Id    : constant Entity_Id  := Defining_Identifier (Decl);
+      Obj_Typ   : constant Node_Id    := Etype (Obj_Id);
+      Desig_Typ : Entity_Id;
+      Expr      : Node_Id;
+      Fin_Call  : Node_Id;
+      Ptr_Id    : Entity_Id;
+      Temp_Id   : Entity_Id;
+
+   --  Start of processing for Process_Transient_Object
+
+   begin
+      --  Step 1: Create the access type which provides a reference to the
+      --  transient controlled object.
+
+      if Is_Access_Type (Obj_Typ) then
+         Desig_Typ := Directly_Designated_Type (Obj_Typ);
+      else
+         Desig_Typ := Obj_Typ;
+      end if;
+
+      Desig_Typ := Base_Type (Desig_Typ);
+
+      --  Generate:
+      --    Ann : access [all] <Desig_Typ>;
+
+      Ptr_Id := Make_Temporary (Loc, 'A');
+
+      Insert_Action (Context,
+        Make_Full_Type_Declaration (Loc,
+          Defining_Identifier => Ptr_Id,
+          Type_Definition     =>
+            Make_Access_To_Object_Definition (Loc,
+              All_Present        => Ekind (Obj_Typ) = E_General_Access_Type,
+              Subtype_Indication => New_Reference_To (Desig_Typ, Loc))));
+
+      --  Step 2: Create a temporary which acts as a hook to the transient
+      --  controlled object. Generate:
+
+      --    Temp : Ptr_Id := null;
+
+      Temp_Id := Make_Temporary (Loc, 'T');
+
+      Insert_Action (Context,
+        Make_Object_Declaration (Loc,
+          Defining_Identifier => Temp_Id,
+          Object_Definition   => New_Reference_To (Ptr_Id, Loc)));
+
+      --  Mark the temporary as created for the purposes of exporting the
+      --  transient controlled object out of the expression_with_action or if
+      --  expression. This signals the machinery in Build_Finalizer to treat
+      --  this case specially.
+
+      Set_Status_Flag_Or_Transient_Decl (Temp_Id, Decl);
+
+      --  Step 3: Hook the transient object to the temporary
+
+      --  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
+      --  points to an existing object.
+
+      if Is_Access_Type (Obj_Typ) then
+         Expr := Unchecked_Convert_To (Ptr_Id, New_Reference_To (Obj_Id, Loc));
+      else
+         Expr :=
+           Make_Attribute_Reference (Loc,
+             Prefix         => New_Reference_To (Obj_Id, Loc),
+             Attribute_Name => Name_Unrestricted_Access);
+      end if;
+
+      --  Generate:
+      --    Temp := Ptr_Id (Obj_Id);
+      --      <or>
+      --    Temp := Obj_Id'Unrestricted_Access;
+
+      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:
+
+      --    if Temp /= null then
+      --       [Deep_]Finalize (Temp.all);
+      --       Temp := null;
+      --    end if;
+
+      --  When the node is part of a return statement, there is no need to
+      --  insert a finalization call, as the general finalization mechanism
+      --  (see Build_Finalizer) would take care of the transient controlled
+      --  object on subprogram exit. Note that it would also be impossible to
+      --  insert the finalization code after the return statement as this will
+      --  render it unreachable.
+
+      if Nkind (Context) /= N_Simple_Return_Statement then
+         Fin_Call :=
+           Make_Implicit_If_Statement (Decl,
+             Condition =>
+               Make_Op_Ne (Loc,
+                 Left_Opnd  => New_Reference_To (Temp_Id, Loc),
+                 Right_Opnd => Make_Null (Loc)),
+
+             Then_Statements => New_List (
+               Make_Final_Call
+                 (Obj_Ref =>
+                    Make_Explicit_Dereference (Loc,
+                      Prefix => New_Reference_To (Temp_Id, Loc)),
+                  Typ     => Desig_Typ),
+
+               Make_Assignment_Statement (Loc,
+                 Name       => New_Reference_To (Temp_Id, Loc),
+                 Expression => Make_Null (Loc))));
+
+         --  Use the Actions list of logical operators when inserting the
+         --  finalization call. This ensures that all transient controlled
+         --  objects are finalized after the operators are evaluated.
+
+         if Nkind_In (Context, N_And_Then, N_Or_Else) then
+            Insert_Action (Context, Fin_Call);
+         else
+            Insert_Action_After (Context, Fin_Call);
+         end if;
+      end if;
+   end Process_Transient_Object;
+
    ------------------------
    -- Rewrite_Comparison --
    ------------------------
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 0473bfafc1d..ca8bc9839ab 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -8040,11 +8040,11 @@ package body Exp_Util is
       Par : Node_Id;
 
    begin
-      --  Locate an enclosing case or if expression. Note: these constructs can
-      --  get expanded into Expression_With_Actions, hence the need to test
-      --  using the original node.
+      --  Locate an enclosing case or if expression. Note that these constructs
+      --  can be expanded into Expression_With_Actions, hence the test of the
+      --  original node.
 
-      Par := N;
+      Par := Parent (N);
       while Present (Par) loop
          if Nkind_In (Original_Node (Par), N_Case_Expression,
                                            N_If_Expression)
diff --git a/gcc/ada/s-interr.ads b/gcc/ada/s-interr.ads
index 1d936f5a5f0..a771db6f8a3 100644
--- a/gcc/ada/s-interr.ads
+++ b/gcc/ada/s-interr.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL 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- --
@@ -256,8 +256,7 @@ package System.Interrupts is
      (Object : access Static_Interrupt_Protection) return Boolean;
    --  Returns True
 
-   overriding
-   procedure Finalize (Object : in out Static_Interrupt_Protection);
+   overriding procedure Finalize (Object : in out Static_Interrupt_Protection);
    --  Restore previous handlers as required by C.3.1(12) then call
    --  Finalize (Protection).