From 7985fb9d646fd6055628289c26e20bd20488ab49 Mon Sep 17 00:00:00 2001 From: charlet Date: Thu, 13 Dec 2007 10:25:35 +0000 Subject: 2007-12-06 Javier Miranda Ed Schonberg * 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 --- gcc/ada/exp_ch7.adb | 44 +++++++++++++++++++++++++++----------------- 1 file changed, 27 insertions(+), 17 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index a2324ed150a..82d80bb9501 100644 --- 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 -- cgit v1.2.1