2007-12-06 Javier Miranda <miranda@adacore.com>

	    Ed Schonberg  <schonberg@adacore.com>

	* exp_ch7.adb (Expand_N_Package_Body): Replace occurrence of attribute
	Is_Complation_Unit by Is_Library_Level_Entity in the code
	that decides if the static dispatch tables need to be built.
	(Wrap_Transient_Declaration): Do not generate a finalization call if
	this is a renaming declaration and the renamed object is a component
	of a controlled type.

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

diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index a2324ed..82d80bb 100644 (file)
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -990,9 +990,7 @@ package body Exp_Ch7 is
 
       Ftyp := Etype (Fent);
 
-      if Nkind (Arg) = N_Type_Conversion
-        or else Nkind (Arg) = N_Unchecked_Type_Conversion
-      then
+      if Nkind_In (Arg, N_Type_Conversion, N_Unchecked_Type_Conversion) then
          Atyp := Entity (Subtype_Mark (Arg));
       else
          Atyp := Etype (Arg);
@@ -1015,8 +1013,7 @@ package body Exp_Ch7 is
       --  Make_Init_Call, set the target type to the type of the formal
       --  directly, to avoid spurious typing problems.
 
-      elsif (Nkind (Arg) = N_Unchecked_Type_Conversion
-              or else Nkind (Arg) = N_Type_Conversion)
+      elsif Nkind_In (Arg, N_Unchecked_Type_Conversion, N_Type_Conversion)
         and then not Is_Class_Wide_Type (Atyp)
       then
          Set_Subtype_Mark (Arg, New_Occurrence_Of (Ftyp, Sloc (Arg)));
@@ -1582,7 +1579,7 @@ package body Exp_Ch7 is
 
          --  Build dispatch tables of library level tagged types
 
-         if Is_Compilation_Unit (Ent) then
+         if Is_Library_Level_Entity (Ent) then
             Build_Static_Dispatch_Tables (N);
          end if;
 
@@ -1851,12 +1848,9 @@ package body Exp_Ch7 is
             when N_Entry_Call_Statement     |
                  N_Procedure_Call_Statement =>
                if Nkind (Parent (The_Parent)) = N_Entry_Call_Alternative
-                 and then
-                   (Nkind (Parent (Parent (The_Parent)))
-                     = N_Timed_Entry_Call
-                   or else
-                     Nkind (Parent (Parent (The_Parent)))
-                       = N_Conditional_Entry_Call)
+                 and then Nkind_In (Parent (Parent (The_Parent)),
+                                    N_Timed_Entry_Call,
+                                    N_Conditional_Entry_Call)
                then
                   return Parent (Parent (The_Parent));
                else
@@ -3393,19 +3387,35 @@ package body Exp_Ch7 is
          --  exit but it doesn't matter. It cannot be done when the
          --  call initializes a renaming object though because in this
          --  case, the object becomes a pointer to the temporary and thus
-         --  increases its life span.
+         --  increases its life span. Ditto if this is a renaming of a
+         --  component of an expression (such as a function call). .
+         --  Note that there is a problem if an actual in the call needs
+         --  finalization, because in that case the call itself is the master,
+         --  and the actual should be finalized on return from the call ???
 
          if Nkind (N) = N_Object_Renaming_Declaration
            and then Controlled_Type (Etype (Defining_Identifier (N)))
          then
             null;
 
+         elsif Nkind (N) = N_Object_Renaming_Declaration
+           and then
+             Nkind_In (Renamed_Object (Defining_Identifier (N)),
+                       N_Selected_Component,
+                       N_Indexed_Component)
+           and then
+             Controlled_Type
+               (Etype (Prefix (Renamed_Object (Defining_Identifier (N)))))
+         then
+            null;
+
          else
             Nodes :=
-              Make_Final_Call (
-                   Ref         => New_Reference_To (LC, Loc),
-                   Typ         => Etype (LC),
-                   With_Detach => New_Reference_To (Standard_False, Loc));
+              Make_Final_Call
+                (Ref         => New_Reference_To (LC, Loc),
+                 Typ         => Etype (LC),
+                 With_Detach => New_Reference_To (Standard_False, Loc));
+
             if Present (Next_N) then
                Insert_List_Before_And_Analyze (Next_N, Nodes);
             else