procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

exp_ch5.adb (Expand_N_Assignment_Statement): In case of tagged types and the assignment to a class-wide object...

Browse source 
2005-12-05  Javier Miranda  <miranda@adacore.com>

	* exp_ch5.adb (Expand_N_Assignment_Statement): In case of tagged types
	and the assignment to a class-wide object, before the assignment we
	generate a run-time check to ensure that the tag of the Target is
	covered by the tag of the source.

From-SVN: r108292
This commit is contained in:
Javier Miranda 2005-12-09 18:18:26 +01:00 • committed by Arnaud Charlet
parent dc503cef64
commit d82e89e9de
1 changed files with 33 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

35
gcc/ada/exp_ch5.adb
View file

@ -1705,13 +1705,44 @@ package body Exp_Ch5 is
begin
-- If the assignment is dispatching, make sure to use the
-- ??? where is rest of this comment ???
-- proper type.
if Is_Class_Wide_Type (Typ) then
F_Typ := Class_Wide_Type (F_Typ);
end if;
L := New_List (
L := New_List;
-- In case of assignment to a class-wide tagged type, before
-- the assignment we generate run-time check to ensure that
-- the tag of the Target is covered by the tag of the source
if Is_Class_Wide_Type (Typ)
and then Is_Tagged_Type (Typ)
and then Is_Tagged_Type (Underlying_Type (Etype (Rhs)))
then
Append_To (L,
Make_Raise_Constraint_Error (Loc,
Condition =>
Make_Op_Not (Loc,
Make_Function_Call (Loc,
Name => New_Reference_To
(RTE (RE_CW_Membership), Loc),
Parameter_Associations => New_List (
Make_Selected_Component (Loc,
Prefix =>
Duplicate_Subexpr (Lhs),
Selector_Name =>
Make_Identifier (Loc, Name_uTag)),
Make_Selected_Component (Loc,
Prefix =>
Duplicate_Subexpr (Rhs),
Selector_Name =>
Make_Identifier (Loc, Name_uTag))))),
Reason => CE_Tag_Check_Failed));
end if;
Append_To (L,
Make_Procedure_Call_Statement (Loc,
Name => New_Reference_To (Op, Loc),
Parameter_Associations => New_List (