From d82e89e9defbe9f2b9ddbbd4873f2706e30c9f27 Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Fri, 9 Dec 2005 18:18:26 +0100 Subject: [PATCH] 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 * 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 --- gcc/ada/exp_ch5.adb | 35 +++++++++++++++++++++++++++++++++-- 1 file changed, 33 insertions(+), 2 deletions(-) diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index af7cd2426f7..f28d87d33d5 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 ( -- 2.30.2