[multiple changes]

2011-09-01  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch7.adb (Find_Insertion_List): New routine.
	(Process_Transient_Objects): Add code to handle the abnormal
	finalization of a controlled transient associated with a subprogram
	call. Since transients are cleaned up right after the associated
	context, an exception raised during a subprogram call may bypass the
	finalization code.

2011-09-01  Robert Dewar  <dewar@adacore.com>

	* exp_ch6.adb (Expand_Call): Check actual for aliased parameter is
	aliased.

From-SVN: r178403

gcc/ada/ChangeLog

+2011-09-01  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch7.adb (Find_Insertion_List): New routine.
+	(Process_Transient_Objects): Add code to handle the abnormal
+	finalization of a controlled transient associated with a subprogram
+	call. Since transients are cleaned up right after the associated
+	context, an exception raised during a subprogram call may bypass the
+	finalization code.
+
+2011-09-01  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch6.adb (Expand_Call): Check actual for aliased parameter is
+	aliased.
+
 2011-09-01  Robert Dewar  <dewar@adacore.com>
 
 	* exp_ch4.adb, a-exexda.adb: Minor reformatting.

gcc/ada/exp_ch6.adb

@@ -2208,8 +2208,8 @@ package body Exp_Ch6 is
       --  as we go through the loop, since this is a convenient place to do it.
       --  (Though it seems that this would be better done in Expand_Actuals???)
 
-      Formal      := First_Formal (Subp);
-      Actual      := First_Actual (Call_Node);
+      Formal := First_Formal (Subp);
+      Actual := First_Actual (Call_Node);
       Param_Count := 1;
       while Present (Formal) loop
 
@@ -2235,7 +2235,7 @@ package body Exp_Ch6 is
            CW_Interface_Formals_Present
              or else
                (Ekind (Etype (Formal)) = E_Class_Wide_Type
-                  and then Is_Interface (Etype (Etype (Formal))))
+                 and then Is_Interface (Etype (Etype (Formal))))
              or else
                (Ekind (Etype (Formal)) = E_Anonymous_Access_Type
                  and then Is_Interface (Directly_Designated_Type
@@ -2616,6 +2616,15 @@ package body Exp_Ch6 is
             end if;
          end if;
 
+         --  For Ada 2012, if a parameter is aliased, the actual must be an
+         --  aliased object.
+
+         if Is_Aliased (Formal) and then not Is_Aliased_View (Actual) then
+            Error_Msg_NE
+              ("actual for aliased formal& must be aliased object",
+               Actual, Formal);
+         end if;
+
          --  For IN OUT and OUT parameters, ensure that subscripts are valid
          --  since this is a left side reference. We only do this for calls
          --  from the source program since we assume that compiler generated
@@ -2667,9 +2676,7 @@ package body Exp_Ch6 is
                --  or IN OUT parameter! We do reset the Is_Known_Valid flag
                --  since the subprogram could have returned in invalid value.
 
-               if (Ekind (Formal) = E_Out_Parameter
-                     or else
-                   Ekind (Formal) = E_In_Out_Parameter)
+               if Ekind_In (Formal, E_Out_Parameter, E_In_Out_Parameter)
                  and then Is_Assignable (Ent)
                then
                   Sav := Last_Assignment (Ent);

gcc/ada/exp_ch7.adb

@@ -4198,17 +4198,51 @@ package body Exp_Ch7 is
          Last_Object  : Node_Id;
          Related_Node : Node_Id)
       is
-         Finalizer_Data  : Finalization_Exception_Data;
-         Finalizer_Decls : List_Id;
-         Built           : Boolean := False;
-         Desig           : Entity_Id;
-         Fin_Block       : Node_Id;
-         Last_Fin        : Node_Id := Empty;
-         Loc             : Source_Ptr;
-         Obj_Id          : Entity_Id;
-         Obj_Ref         : Node_Id;
-         Obj_Typ         : Entity_Id;
-         Stmt            : Node_Id;
+         function Find_Insertion_List return List_Id;
+         --  Return the statement list of the enclosing sequence of statements
+
+         -------------------------
+         -- Find_Insertion_List --
+         -------------------------
+
+         function Find_Insertion_List return List_Id is
+            Par : Node_Id;
+
+         begin
+            --  Climb up the tree looking for the enclosing sequence of
+            --  statements.
+
+            Par := N;
+            while Present (Par)
+              and then Nkind (Par) /= N_Handled_Sequence_Of_Statements
+            loop
+               Par := Parent (Par);
+            end loop;
+
+            return Statements (Par);
+         end Find_Insertion_List;
+
+         --  Local variables
+
+         Requires_Hooking : constant Boolean :=
+                              Nkind_In (N, N_Function_Call,
+                                           N_Procedure_Call_Statement);
+
+         Built     : Boolean := False;
+         Desig_Typ : Entity_Id;
+         Fin_Block : Node_Id;
+         Fin_Data  : Finalization_Exception_Data;
+         Fin_Decls : List_Id;
+         Last_Fin  : Node_Id := Empty;
+         Loc       : Source_Ptr;
+         Obj_Id    : Entity_Id;
+         Obj_Ref   : Node_Id;
+         Obj_Typ   : Entity_Id;
+         Stmt      : Node_Id;
+         Stmts     : List_Id;
+         Temp_Id   : Entity_Id;
+
+      --  Start of processing for Process_Transient_Objects
 
       begin
          --  Examine all objects in the list First_Object .. Last_Object
@@ -4224,34 +4258,151 @@ package body Exp_Ch7 is
 
               and then Stmt /= Related_Node
             then
-               Loc     := Sloc (Stmt);
-               Obj_Id  := Defining_Identifier (Stmt);
-               Obj_Typ := Base_Type (Etype (Obj_Id));
-               Desig   := Obj_Typ;
+               Loc       := Sloc (Stmt);
+               Obj_Id    := Defining_Identifier (Stmt);
+               Obj_Typ   := Base_Type (Etype (Obj_Id));
+               Desig_Typ := Obj_Typ;
 
                Set_Is_Processed_Transient (Obj_Id);
 
                --  Handle access types
 
-               if Is_Access_Type (Desig) then
-                  Desig := Available_View (Designated_Type (Desig));
+               if Is_Access_Type (Desig_Typ) then
+                  Desig_Typ := Available_View (Designated_Type (Desig_Typ));
                end if;
 
                --  Create the necessary entities and declarations the first
                --  time around.
 
                if not Built then
-                  Finalizer_Decls := New_List;
-                  Build_Object_Declarations
-                      (Finalizer_Data, Finalizer_Decls, Loc);
+                  Fin_Decls := New_List;
 
-                  Insert_List_Before_And_Analyze
-                    (First_Object, Finalizer_Decls);
+                  Build_Object_Declarations (Fin_Data, Fin_Decls, Loc);
+                  Insert_List_Before_And_Analyze (First_Object, Fin_Decls);
 
                   Built := True;
                end if;
 
+               --  Transient variables associated with subprogram calls need
+               --  extra processing. These variables are usually created right
+               --  before the call and finalized immediately after the call.
+               --  If an exception occurs during the call, the clean up code
+               --  is skipped due to the sudden change in control and the
+               --  transient is never finalized.
+
+               --  To handle this case, such variables are "exported" to the
+               --  enclosing sequence of statements where their corresponding
+               --  "hooks" are picked up by the finalization machinery.
+
+               if Requires_Hooking then
+                  declare
+                     Ins_List  : constant List_Id := Find_Insertion_List;
+                     Expr      : Node_Id;
+                     Ptr_Decl  : Node_Id;
+                     Ptr_Id    : Entity_Id;
+                     Temp_Decl : Node_Id;
+
+                  begin
+                     --  Step 1: Create an access type which provides a
+                     --  reference to the transient object. Generate:
+
+                     --    Ann : access [all] <Desig_Typ>;
+
+                     Ptr_Id := Make_Temporary (Loc, 'A');
+
+                     Ptr_Decl :=
+                       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');
+
+                     Temp_Decl :=
+                       Make_Object_Declaration (Loc,
+                         Defining_Identifier => Temp_Id,
+                         Object_Definition   =>
+                           New_Reference_To (Ptr_Id, Loc));
+
+                     --  Analyze the access type and the hook declarations
+
+                     Prepend_To (Ins_List, Temp_Decl);
+                     Prepend_To (Ins_List, Ptr_Decl);
+
+                     Analyze (Ptr_Decl);
+                     Analyze (Temp_Decl);
+
+                     --  Mark the temporary as a transient hook. This signals
+                     --  the machinery in Build_Finalizer to recognize this
+                     --  special case.
+
+                     Set_Return_Flag_Or_Transient_Decl (Temp_Id, Stmt);
+
+                     --  Step 3: Hook the transient object to the temporary
+
+                     if Is_Access_Type (Obj_Typ) then
+                        Expr :=
+                          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 (Stmt,
+                       Make_Assignment_Statement (Loc,
+                         Name       => New_Reference_To (Temp_Id, Loc),
+                         Expression => Expr));
+                  end;
+               end if;
+
+               Stmts := New_List;
+
+               --  The transient object is about to be finalized by the clean
+               --  up code following the subprogram call. In order to avoid
+               --  double finalization, clear the hook.
+
+               --  Generate:
+               --    Temp := null;
+
+               if Requires_Hooking then
+                  Append_To (Stmts,
+                    Make_Assignment_Statement (Loc,
+                      Name       => New_Reference_To (Temp_Id, Loc),
+                      Expression => Make_Null (Loc)));
+               end if;
+
+               --  Generate:
+               --    [Deep_]Finalize (Obj_Ref);
+
+               Obj_Ref := New_Reference_To (Obj_Id, Loc);
+
+               if Is_Access_Type (Obj_Typ) then
+                  Obj_Ref := Make_Explicit_Dereference (Loc, Obj_Ref);
+               end if;
+
+               Append_To (Stmts,
+                 Make_Final_Call
+                   (Obj_Ref => Obj_Ref,
+                    Typ     => Desig_Typ));
+
                --  Generate:
+               --    [Temp := null;]
                --    begin
                --       [Deep_]Finalize (Obj_Ref);
 
@@ -4264,23 +4415,14 @@ package body Exp_Ch7 is
                --          end if;
                --    end;
 
-               Obj_Ref := New_Reference_To (Obj_Id, Loc);
-
-               if Is_Access_Type (Obj_Typ) then
-                  Obj_Ref := Make_Explicit_Dereference (Loc, Obj_Ref);
-               end if;
-
                Fin_Block :=
                  Make_Block_Statement (Loc,
                    Handled_Statement_Sequence =>
                      Make_Handled_Sequence_Of_Statements (Loc,
-                       Statements => New_List (
-                         Make_Final_Call
-                           (Obj_Ref => Obj_Ref,
-                            Typ     => Desig)),
-
+                       Statements => Stmts,
                        Exception_Handlers => New_List (
-                         Build_Exception_Handler (Finalizer_Data))));
+                         Build_Exception_Handler (Fin_Data))));
+
                Insert_After_And_Analyze (Last_Object, Fin_Block);
 
                --  The raise statement must be inserted after all the
@@ -4345,7 +4487,7 @@ package body Exp_Ch7 is
            and then Present (Last_Fin)
          then
             Insert_After_And_Analyze (Last_Fin,
-              Build_Raise_Statement (Finalizer_Data));
+              Build_Raise_Statement (Fin_Data));
          end if;
       end Process_Transient_Objects;