Patchwork [Ada] Transient controlled function results in if expressions

login
register
mail settings
Submitter Arnaud Charlet
Date July 8, 2013, 7:52 a.m.
Message ID <20130708075258.GA22711@adacore.com>
Download mbox | patch
Permalink /patch/257483/
State New
Headers show

Comments

Arnaud Charlet - July 8, 2013, 7:52 a.m.
This patch corrects the expansion of if expressions to generate finalization
code for transient controlled function results that appear in the "then" or
"else" alternatives. The transient objects are now properly finalized after the
if expression is evaluated.

------------
-- Source --
------------

--  types.ads

with Ada.Finalization; use Ada.Finalization;

package Types is
   type Ctrl_Typ is new Controlled with record
      Id : Natural;
   end record;

   overriding procedure Adjust (Obj : in out Ctrl_Typ);
   overriding procedure Finalize (Obj : in out Ctrl_Typ);
   overriding procedure Initialize (Obj : in out Ctrl_Typ);

   function Next_Id return Natural;

   function Make_Ctrl return Ctrl_Typ;
   function Make_Ctrl (Obj : Ctrl_Typ) return Ctrl_Typ;
end Types;

--  types.adb

with Ada.Text_IO; use Ada.Text_IO;

package body Types is
   Id_Gen : Natural := 0;

   overriding procedure Adjust (Obj : in out Ctrl_Typ) is
      New_Id : constant Natural := Obj.Id * 10;
   begin
      Put_Line ("  Adjust    " & Obj.Id'Img & " ->" & New_Id'Img);
      Obj.Id := New_Id;
   end Adjust;

   overriding procedure Finalize (Obj : in out Ctrl_Typ) is
   begin
      Put_Line ("  Finalize  " & Obj.Id'Img);
      Obj.Id := 0;
   end Finalize;

   overriding procedure Initialize (Obj : in out Ctrl_Typ) is
   begin
      Obj.Id := Next_Id;
      Put_Line ("  Initialize" & Obj.Id'Img);
   end Initialize;

   function Make_Ctrl return Ctrl_Typ is
      Result : Ctrl_Typ;
   begin
      return Result;
   end Make_Ctrl;

   function Make_Ctrl (Obj : Ctrl_Typ) return Ctrl_Typ is
   begin
      return Ctrl_Typ'(Controlled with Id => Obj.Id);
   end Make_Ctrl;

   function Next_Id return Natural is
   begin
      Id_Gen := Id_Gen + 1;
      return Id_Gen;
   end Next_Id;
end Types;

--  main.adb

with Ada.Text_IO; use Ada.Text_IO;
with Types;       use Types;

procedure Main is
   procedure Param (Obj : Ctrl_Typ) is
   begin
      Put_Line ("Param");
   end Param;

   Cond  : Boolean := True;
   Dummy : Ctrl_Typ;

begin
   Put_Line ("== Assignment ==");
   begin
      Dummy := (if Cond then Make_Ctrl (Make_Ctrl) else Dummy);
   end;

   Put_Line ("== Actual parameter ==");
   begin
      Param (if Cond then Make_Ctrl (Make_Ctrl) else Dummy);
   end;

   Put_Line ("== End ==");
end Main;

----------------------------
-- Compilation and output --
----------------------------

$ gnatmake -q -gnat12 main.adb
$ ./main
  Initialize 1
== Assignment ==
  Initialize 2
  Adjust     2 -> 20
  Finalize   2
  Adjust     20 -> 200
  Finalize   20
  Finalize   1
  Adjust     200 -> 2000
  Finalize   200
  Finalize   20
== Actual parameter ==
  Initialize 3
  Adjust     3 -> 30
  Finalize   3
  Adjust     30 -> 300
  Finalize   30
Param
  Finalize   300
  Finalize   30
== End ==
  Finalize   2000

Tested on x86_64-pc-linux-gnu, committed on trunk

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.

Patch

Index: exp_util.adb
===================================================================
--- exp_util.adb	(revision 200688)
+++ exp_util.adb	(working copy)
@@ -8040,11 +8040,11 @@ 
       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)
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb	(revision 200758)
+++ exp_ch4.adb	(working copy)
@@ -233,6 +233,16 @@ 
    --  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 @@ 
    --------------------------------------
 
    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 @@ 
          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,68 +5120,32 @@ 
    --  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.
+      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.
 
-      function Is_Controlled_Function_Call (Expr : Node_Id) return Boolean;
-      --  Determine if expression Expr is a rewritten controlled function call
+      ---------------------
+      -- Process_Actions --
+      ---------------------
 
-      ------------------------
-      -- Create_Alternative --
-      ------------------------
+      procedure Process_Actions (Actions : List_Id) is
+         Act : Node_Id;
 
-      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;
-
       begin
-         --  Generate:
-         --    Fnn := True;
+         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;
 
-         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;
+            Next (Act);
+         end loop;
+      end Process_Actions;
 
-         --  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 --
-      ---------------------------------
-
-      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;
-
       --  Local variables
 
       Loc    : constant Source_Ptr := Sloc (N);
@@ -5469,6 +5160,7 @@ 
       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 @@ 
       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;
+         Process_Actions (Then_Actions (N));
+         Process_Actions (Else_Actions (N));
 
-            --  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.
+         --  Generate:
+         --    type Ann is access all Typ;
 
-            if Is_Controlled_Function_Call (Thenx)
-                 or else
-               Is_Controlled_Function_Call (Elsex)
-            then
-               Flag_Id := Make_Temporary (Loc, 'F');
+         Ptr_Typ := Make_Temporary (Loc, 'A');
 
-               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;
+         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))));
 
-            --  Generate:
-            --    type Ann is access all Typ;
+         --  Generate:
+         --    Cnn : Ann;
 
-            Ptr_Typ := Make_Temporary (Loc, 'A');
+         Cnn := Make_Temporary (Loc, 'C', N);
 
-            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))));
+         Decl :=
+           Make_Object_Declaration (Loc,
+             Defining_Identifier => Cnn,
+             Object_Definition   => New_Occurrence_Of (Ptr_Typ, Loc));
 
-            --  Generate:
-            --    Cnn : Ann;
+         --  Generate:
+         --    if Cond then
+         --       Cnn := <Thenx>'Unrestricted_Access;
+         --    else
+         --       Cnn := <Elsex>'Unrestricted_Access;
+         --    end if;
 
-            Cnn := Make_Temporary (Loc, 'C', N);
-            Set_Ekind (Cnn, E_Variable);
-            Set_Status_Flag_Or_Transient_Decl (Cnn, Flag_Id);
+         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))),
 
-            Decl :=
-               Make_Object_Declaration (Loc,
-                 Defining_Identifier => Cnn,
-                 Object_Definition   => New_Occurrence_Of (Ptr_Typ, Loc));
+             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_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));
-
             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 @@ 
 
          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 @@ 
       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 --
    ------------------------