diff options
| author | Javier Miranda <miranda@adacore.com> | 2005-12-09 18:18:26 +0100 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2005-12-09 18:18:26 +0100 |
| commit | d82e89e9defbe9f2b9ddbbd4873f2706e30c9f27 (patch) | |
| tree | f98aa66d57f20bce6f85cf529f50157ce414093f /gcc | |
| parent | dc503cef64e1eda4b4be760112de394207dbd096 (diff) | |
| download | gcc-d82e89e9defbe9f2b9ddbbd4873f2706e30c9f27.zip gcc-d82e89e9defbe9f2b9ddbbd4873f2706e30c9f27.tar.gz gcc-d82e89e9defbe9f2b9ddbbd4873f2706e30c9f27.tar.bz2 | |
exp_ch5.adb (Expand_N_Assignment_Statement): In case of tagged types and the assignment to a class-wide object...
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
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/exp_ch5.adb | 35 |
1 files changed, 33 insertions, 2 deletions
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index af7cd24..f28d87d 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -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 ( |