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

exp_intr.adb (Expand_Unc_Deallocation): Add missing support for deallocation of class-wide interface objects. 

2007-04-20  Javier Miranda  <miranda@adacore.com>

	* exp_intr.adb (Expand_Unc_Deallocation): Add missing support for
	deallocation of class-wide interface objects.
	(Expand_Dispatching_Constructor_Call): Take into account that if the
	result of the dispatching constructor is an interface type, the
	function returns a class-wide interface type; otherwise the returned
	object would be actual. The frontend previously accepted returning
	interface types because Expand_Interface_Actuals silently performed
	the management of the returned type "as if" it were a class-wide
	interface type.
	(Expand_Dispatching_Constructor_Call): Replace call to
	Make_DT_Access_Action by direct call to Make_Function_Call.

From-SVN: r125406
This commit is contained in:
Javier Miranda 2007-06-06 12:27:12 +02:00 committed by Arnaud Charlet
parent cde4a4b1a3
commit b545a0f665
1 changed files with 33 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
gcc/ada/exp_intr.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -34,7 +34,6 @@ with Exp_Ch4; use Exp_Ch4;
with Exp_Ch7; use Exp_Ch7;
with Exp_Ch11; use Exp_Ch11;
with Exp_Code; use Exp_Code;
with Exp_Disp; use Exp_Disp;
with Exp_Fixd; use Exp_Fixd;
with Exp_Util; use Exp_Util;
with Freeze; use Freeze;
@ -155,6 +154,14 @@ package body Exp_Intr is
Act_Constr := Entity (Name (Act_Rename));
Result_Typ := Class_Wide_Type (Etype (Act_Constr));
-- Ada 2005 (AI-251): If the result is an interface type, the function
-- returns a class-wide interface type (otherwise the resulting object
-- would be abstract!)
if Is_Interface (Etype (Act_Constr)) then
Set_Etype (Act_Constr, Result_Typ);
end if;
-- Create the call to the actual Constructor function
Cnstr_Call :=
@ -215,9 +222,9 @@ package body Exp_Intr is
Make_Implicit_If_Statement (N,
Condition =>
Make_Op_Not (Loc,
Make_DT_Access_Action (Result_Typ,
Action => IW_Membership,
Args => New_List (
Make_Function_Call (Loc,
Name => New_Occurrence_Of (RTE (RE_IW_Membership), Loc),
Parameter_Associations => New_List (
Make_Attribute_Reference (Loc,
Prefix => Duplicate_Subexpr (Tag_Arg),
Attribute_Name => Name_Address),
@ -984,7 +991,27 @@ package body Exp_Intr is
end if;
end if;
Set_Expression (Free_Node, Free_Arg);
-- Ada 2005 (AI-251): In case of abstract interface type we must
-- displace the pointer to reference the base of the object to
-- deallocate its memory.
-- Generate:
-- free (Base_Address (Obj_Ptr))
if Is_Interface (Directly_Designated_Type (Typ)) then
Set_Expression (Free_Node,
Unchecked_Convert_To (Typ,
Make_Function_Call (Loc,
Name => New_Reference_To (RTE (RE_Base_Address), Loc),
Parameter_Associations => New_List (
Unchecked_Convert_To (RTE (RE_Address), Free_Arg)))));
-- Generate:
-- free (Obj_Ptr)
else
Set_Expression (Free_Node, Free_Arg);
end if;
-- Only remaining step is to set result to null, or generate a
-- raise of constraint error if the target object is "not null".