From 5150978dfe1b049f16bed80aad2163c43be039cf Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Thu, 6 Oct 2022 21:44:43 +0000 Subject: ada: Skip dynamic interface conversion under configurable runtime gcc/ada/ * exp_disp.adb (Expand_Interface_Conversion): Under configurable runtime, when the target type is an interface that is an ancestor of the operand type, skip generating code to displace the pointer to reference the target dispatch table. * sem_disp.adb (Propagate_Tag): Handle class-wide types when checking for the addition of an implicit interface conversion. --- gcc/ada/sem_disp.adb | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) (limited to 'gcc/ada/sem_disp.adb') diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index ee1d96e..af26013 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -3072,18 +3072,27 @@ package body Sem_Disp is if Tagged_Type_Expansion then declare - Call_Typ : constant Entity_Id := Etype (Call_Node); + Call_Typ : Entity_Id := Etype (Call_Node); + Ctrl_Typ : Entity_Id := Etype (Control); begin Expand_Dispatching_Call (Call_Node); + if Is_Class_Wide_Type (Call_Typ) then + Call_Typ := Root_Type (Call_Typ); + end if; + + if Is_Class_Wide_Type (Ctrl_Typ) then + Ctrl_Typ := Root_Type (Ctrl_Typ); + end if; + -- If the controlling argument is an interface type and the type -- of Call_Node differs then we must add an implicit conversion to -- force displacement of the pointer to the object to reference -- the secondary dispatch table of the interface. - if Is_Interface (Etype (Control)) - and then Etype (Control) /= Call_Typ + if Is_Interface (Ctrl_Typ) + and then Ctrl_Typ /= Call_Typ then -- Cannot use Convert_To because the previous call to -- Expand_Dispatching_Call leaves decorated the Call_Node -- cgit v1.1