OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

exp_ch7.adb (Expand_N_Package_Body): Replace occurrence of attribute Is_Complation_Unit by Is_Library_Level_Entity... 

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.

From-SVN: r130832
This commit is contained in:
Javier Miranda 2007-12-13 11:25:35 +01:00 committed by Arnaud Charlet
parent 303b4d58d7
commit d07e197c87
1 changed files with 27 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
gcc/ada/exp_ch7.adb
View File

@ -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