2006-10-31 Bob Duff <duff@adacore.com>

	    Ed Schonberg  <schonberg@adacore.com>
	    Robert Dewar  <dewar@adacore.com>

	* exp_ch7.adb (Build_Array_Deep_Procs, Build_Record_Deep_Procs,
	Make_Deep_Record_Body): Rename Is_Return_By_Reference_Type to be
	Is_Inherently_Limited_Type, because return-by-reference has no meaning
	in Ada 2005.
	(Find_Node_To_Be_Wrapped): Use new method of determining the result
	type of the function containing a return statement, because the
	Return_Type field was removed. We now use the Return_Applies_To field.

        * exp_util.ads, exp_util.adb: Use new subtype N_Membership_Test
	(Build_Task_Image_Decl): If procedure is not called from an
	initialization procedure, indicate that function that builds task name
	uses the sec. stack. Otherwise the enclosing initialization procedure
	will carry the indication.
	(Insert_Actions): Remove N_Return_Object_Declaration. We now use
	N_Object_Declaration instead.
	(Kill_Dead_Code): New interface to implement -gnatwt warning for
	conditional dead code killed, and change implementation accordingly.
	(Insert_Actions): Add N_Return_Object_Declaration case.
	Correct comment to mention N_Extension_Aggregate node.
	(Set_Current_Value_Condition): Call Safe_To_Capture_Value to avoid bad
	attempts to save information for global variables which cannot be
	safely tracked.
	(Get_Current_Value_Condition): Handle conditions the other way round
	(constant on left). Also handle right operand of AND and AND THEN
	(Set_Current_Value_Condition): Corresponding changes
	(Append_Freeze_Action): Remove unnecessary initialization of Fnode.
	(Get_Current_Value_Condition): Handle simple boolean operands
	(Get_Current_Value_Condition): Handle left operand of AND or AND THEN
	(Get_Current_Value_Condition): If the variable reference is within an
	if-statement, does not appear in the list of then_statments, and does
	not come from source, treat it as being at unknown location.
	(Get_Current_Value_Condition): Enhance to allow while statements to be
	processed as well as if statements.
	(New_Class_Wide_Subtype): The entity for a class-wide subtype does not
	come from source.
	(OK_To_Do_Constant_Replacement): Allow constant replacement within body
	of loop. This is safe now that we fixed Kill_Current_Values.
	(OK_To_Do_Constant_Replacement): Check whether current scope is
	Standard, before examining outer scopes.



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

1 files changed, 15 insertions, 8 deletions

diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 2535bb2c70c..0a4a52714e5 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -380,7 +380,7 @@ package body Exp_Ch7 is
           Typ   => Typ,
           Stmts => Make_Deep_Array_Body (Initialize_Case, Typ)));
 
-      if not Is_Return_By_Reference_Type (Typ) then
+      if not Is_Inherently_Limited_Type (Typ) then
          Set_TSS (Typ,
            Make_Deep_Proc (
              Prim  => Adjust_Case,
@@ -475,7 +475,7 @@ package body Exp_Ch7 is
           Typ   => Typ,
           Stmts => Make_Deep_Record_Body (Initialize_Case, Typ)));
 
-      if not Is_Return_By_Reference_Type (Typ) then
+      if not Is_Inherently_Limited_Type (Typ) then
          Set_TSS (Typ,
            Make_Deep_Proc (
              Prim  => Adjust_Case,
@@ -1825,11 +1825,18 @@ package body Exp_Ch7 is
             --  itself needs wrapping at the outer-level
 
             when N_Return_Statement            =>
-               if Requires_Transient_Scope (Return_Type (The_Parent)) then
-                  return Empty;
-               else
-                  return The_Parent;
-               end if;
+               declare
+                  Applies_To : constant Entity_Id :=
+                                 Return_Applies_To
+                                   (Return_Statement_Entity (The_Parent));
+                  Return_Type : constant Entity_Id := Etype (Applies_To);
+               begin
+                  if Requires_Transient_Scope (Return_Type) then
+                     return Empty;
+                  else
+                     return The_Parent;
+                  end if;
+               end;
 
             --  If we leave a scope without having been able to find a node to
             --  wrap, something is going wrong but this can happen in error
@@ -2632,7 +2639,7 @@ package body Exp_Ch7 is
       Res            : constant List_Id := New_List;
 
    begin
-      if Is_Return_By_Reference_Type (Typ) then
+      if Is_Inherently_Limited_Type (Typ) then
          Controller_Typ := RTE (RE_Limited_Record_Controller);
       else
          Controller_Typ := RTE (RE_Record_Controller);