From 20dc266e5a178fd87bb8ae6ebbf63e391f74e9b0 Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Fri, 13 Dec 2019 09:04:18 +0000 Subject: [Ada] Deallocation of controlled type implementing interface types 2019-12-13 Javier Miranda gcc/ada/ * exp_disp.ads (Expand_Interface_Thunk): Adding one formal (the interface type). * exp_disp.adb (Expand_Interface_Thunk): Using the added formal to ensure the correct profile of the thunk generated for predefined primitives; in addition, the added formal is also used to perform a check that ensures that the controlling type of the thunk is the one expected by the GCC backend. (Make_Secondary_DT, Register_Primitive): Adding the new formal to the calls to Expand_Interface_Thunk. * exp_ch6.adb (Register_Predefined_DT_Entry): Adding the new formal to the call to Expand_Interface_Thunk. * exp_intr.adb (Expand_Unc_Deallocation): When deallocating a controlled type and the call to unchecked deallocation is performed with a pointer to one of the convered interface types, displace the pointer to the object to reference the base of the object to deallocate its memory. * gcc-interface/trans.c (maybe_make_gnu_thunk): Assert that the controlling type of the thunk is an interface type. From-SVN: r279351 --- gcc/ada/gcc-interface/trans.c | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'gcc/ada/gcc-interface/trans.c') diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 3d6f381..ef16a08 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -11287,11 +11287,12 @@ maybe_make_gnu_thunk (Entity_Id gnat_thunk, tree gnu_thunk) const Entity_Id gnat_controlling_type = get_controlling_type (gnat_target); const Entity_Id gnat_interface_type = get_controlling_type (gnat_thunk); + /* We must have an interface type at this point. */ + gcc_assert (Is_Interface (gnat_interface_type)); + /* Now compute whether the former covers the latter. */ const Entity_Id gnat_interface_tag - = Is_Interface (gnat_interface_type) - ? Find_Interface_Tag (gnat_controlling_type, gnat_interface_type) - : Empty; + = Find_Interface_Tag (gnat_controlling_type, gnat_interface_type); tree gnu_interface_tag = Present (gnat_interface_tag) ? gnat_to_gnu_field_decl (gnat_interface_tag) -- cgit v1.1