[multiple changes]

2011-08-04  Thomas Quinot  <quinot@adacore.com>

	* sinfo.adb, sinfo.ads, sem_prag.adb, sem_ch12.adb (Pragma_Enabled):
	This flag of N_Pragma nodes is not used, remove it as well as all of
	the associated circuitry.

2011-08-04  Javier Miranda  <miranda@adacore.com>

	* exp_disp.adb (Make_DT): Switch -gnatdQ disables the generation of the
	runtime check on duplicated externa tags
	* debug.adb Document switch -gnatdQ.

2011-08-04  Gary Dismukes  <dismukes@adacore.com>

	* a-fihema.ads: Minor typo fix.

2011-08-04  Yannick Moy  <moy@adacore.com>

	* sem_ch10.adb: Minor comment update.

2011-08-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb: Update the node field usage to reflect the renaming of
	Return_Flag to Return_ Flag_Or_Transient_Decl.
	(Return_Flag): Renamed to Return_Flag_Or_Transient_Decl.
	(Set_Return_Flag): Renamed to Set_Return_Flag_Or_Transient_Decl.
	(Write_Field15_Name): Change Return_Flag to
	Return_Flag_Or_Transient_Decl.
	* einfo.ads: Rename node field Return_Flag to
	Return_Flag_Or_Transient_Decl. Update the associated comment and all
	occurrences in entities.
	(Return_Flag): Renamed to Return_Flag_Or_Transient_Decl. Update
	associated Inline pragma.
	(Set_Return_Flag): Renamed to Set_Return_Flag_Or_Transient_Decl. Update
	associated Inline pragma.
	* exp_ch4.ads, exp_ch4.adb (Expand_N_Expression_With_Actions): New
	routine.
	* exp_ch6.adb (Expand_N_Extended_Return_Statement): Update the calls to
	Return_Flag and Set_Return_Flag.
	* exp_ch7.adb (Process_Declarations): Add code to recognize hook
	objects generated for controlled transients declared inside an
	Exception_With_Actions. Update the calls to Return_Flag.
	(Process_Object_Declaration): Add code to add a null guard for hook
	objects generated for controlled transients declared inside an
	Exception_With_Actions. Update related comment.
	* exp_util.adb (Has_Controlled_Objects): Add code to recognize hook
	objects generated for controlled transients declared inside an
	Exception_With_Actions. Update the calls to Return_Flag.
	* expander.adb (Expand): Add new case for N_Expression_With_Actions.

2011-08-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.adb:(Wrong_Type): Improve error message on a one-element
	positional aggregate.

2011-08-04  Vincent Celier  <celier@adacore.com>

	* par_sco.adb (Process_Decisions.Output_Header): Check and record pragma
	SLOC only for pragmas.

2011-08-04  Emmanuel Briot  <briot@adacore.com>

	* projects.texi: Minor typo fix.

2011-08-04  Emmanuel Briot  <briot@adacore.com>

	* prj-nmsc.adb (Check_File): Minor change to traces, to help debugging
	on case-sensitive file systems.

From-SVN: r177349

1 files changed, 70 insertions, 17 deletions

diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index f79520e..5443691 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -1785,6 +1785,15 @@ package body Exp_Ch7 is
                then
                   Processing_Actions (Has_No_Init => True);
 
+               elsif Is_Access_Type (Obj_Typ)
+                 and then Present (Return_Flag_Or_Transient_Decl (Obj_Id))
+                 and then Nkind (Return_Flag_Or_Transient_Decl (Obj_Id)) =
+                                   N_Object_Declaration
+                 and then Is_Finalizable_Transient
+                            (Return_Flag_Or_Transient_Decl (Obj_Id), Decl)
+               then
+                  Processing_Actions (Has_No_Init => True);
+
                --  Simple protected objects which use type System.Tasking.
                --  Protected_Objects.Protection to manage their locks should
                --  be treated as controlled since they require manual cleanup.
@@ -1850,7 +1859,7 @@ package body Exp_Ch7 is
 
                elsif Needs_Finalization (Obj_Typ)
                  and then Is_Return_Object (Obj_Id)
-                 and then Present (Return_Flag (Obj_Id))
+                 and then Present (Return_Flag_Or_Transient_Decl (Obj_Id))
                then
                   Processing_Actions (Has_No_Init => True);
                end if;
@@ -2517,25 +2526,69 @@ package body Exp_Ch7 is
                end;
             end if;
 
-            --  Return objects use a flag to aid their potential finalization
-            --  then the enclosing function fails to return properly. Generate:
-            --
-            --    if not Flag then
-            --       <object finalization statements>
-            --    end if;
-
             if Ekind_In (Obj_Id, E_Constant, E_Variable)
-              and then Is_Return_Object (Obj_Id)
-              and then Present (Return_Flag (Obj_Id))
+              and then Present (Return_Flag_Or_Transient_Decl (Obj_Id))
             then
-               Fin_Stmts := New_List (
-                 Make_If_Statement (Loc,
-                   Condition     =>
-                     Make_Op_Not (Loc,
-                       Right_Opnd =>
-                         New_Reference_To (Return_Flag (Obj_Id), Loc)),
+               --  Return objects use a flag to aid their potential
+               --  finalization when the enclosing function fails to return
+               --  properly. Generate:
+               --
+               --    if not Flag then
+               --       <object finalization statements>
+               --    end if;
+
+               if Is_Return_Object (Obj_Id) then
+                  Fin_Stmts := New_List (
+                    Make_If_Statement (Loc,
+                      Condition     =>
+                        Make_Op_Not (Loc,
+                          Right_Opnd =>
+                            New_Reference_To
+                              (Return_Flag_Or_Transient_Decl (Obj_Id), Loc)),
+
+                    Then_Statements => Fin_Stmts));
+
+               --  Temporaries created for the purpose of "exporting" a
+               --  controlled transient out of an Expression_With_Actions (EWA)
+               --  need guards. The following illustrates the usage of such
+               --  temporaries.
+
+               --    Access_Typ : access [all] Obj_Typ;
+               --    Temp       : Access_Typ := null;
+               --    <Counter>  := ...;
+
+               --    do
+               --       Ctrl_Trans : [access [all]] Obj_Typ := ...;
+               --       Temp := Access_Typ (Ctrl_Trans);  --  when a pointer
+               --         <or>
+               --       Temp := Ctrl_Trans'Unchecked_Access;
+               --    in ... end;
+
+               --  The finalization machinery does not process EWA nodes as
+               --  this may lead to premature finalization of expressions. Note
+               --  that Temp is marked as being properly initialized regardless
+               --  of whether the initialization of Ctrl_Trans succeeded. Since
+               --  a failed initialization may leave Temp with a value of null,
+               --  add a guard to handle this case:
+
+               --    if Obj /= null then
+               --       <object finalization statements>
+               --    end if;
 
-                 Then_Statements => Fin_Stmts));
+               else
+                  pragma Assert
+                    (Nkind (Return_Flag_Or_Transient_Decl (Obj_Id)) =
+                       N_Object_Declaration);
+
+                  Fin_Stmts := New_List (
+                    Make_If_Statement (Loc,
+                      Condition       =>
+                        Make_Op_Ne (Loc,
+                          Left_Opnd  => New_Reference_To (Obj_Id, Loc),
+                          Right_Opnd => Make_Null (Loc)),
+
+                      Then_Statements => Fin_Stmts));
+               end if;
             end if;
          end if;