From 354540f3c4263d565cd07f03ffcc42dcede16b0d Mon Sep 17 00:00:00 2001 From: charlet Date: Tue, 2 Aug 2011 14:28:32 +0000 Subject: 2011-08-02 Ed Schonberg * sem_prag.adb (Chain_PPC): Implement AI04-0230: null procedures can only have inheritable classwide pre/postconditions. 2011-08-02 Javier Miranda * a-tags.ads, a-tags.adb (Check_TSD): New subprogram. * rtsfind.ads (RE_Check_TSD): New runtime entity. * exp_disp.adb (Make_DT): Generate call to the new runtime routine that checks if the external tag of a type is the same as the external tag of some other declaration. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@177159 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/exp_disp.adb | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) (limited to 'gcc/ada/exp_disp.adb') diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 07444e7d4ae..cdc92a34b9c 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -5990,6 +5990,24 @@ package body Exp_Disp is end if; end if; + -- Generate code to check if the external tag of this type is the same + -- as the external tag of some other declaration. + + -- Check_TSD (TSD'Unrestricted_Access); + + if not No_Run_Time_Mode + and then Ada_Version >= Ada_2012 + and then RTE_Available (RE_Check_TSD) + then + Append_To (Elab_Code, + Make_Procedure_Call_Statement (Loc, + Name => New_Reference_To (RTE (RE_Check_TSD), Loc), + Parameter_Associations => New_List ( + Make_Attribute_Reference (Loc, + Prefix => New_Reference_To (TSD, Loc), + Attribute_Name => Name_Unchecked_Access)))); + end if; + -- Generate code to register the Tag in the External_Tag hash table for -- the pure Ada type only. -- cgit v1.2.1