diff options
| author | Javier Miranda <miranda@adacore.com> | 2022-10-06 21:44:43 +0000 |
|---|---|---|
| committer | Marc Poulhiès <poulhies@adacore.com> | 2022-11-04 14:47:27 +0100 |
| commit | 5150978dfe1b049f16bed80aad2163c43be039cf (patch) | |
| tree | 1d5e98104c6626f98049f06b039c81142bc6fdb3 /gcc/ada/sem_disp.adb | |
| parent | e491cb26ecb52b56dd1f5eef284f8871f870fb5b (diff) | |
| download | gcc-5150978dfe1b049f16bed80aad2163c43be039cf.zip gcc-5150978dfe1b049f16bed80aad2163c43be039cf.tar.gz gcc-5150978dfe1b049f16bed80aad2163c43be039cf.tar.bz2 | |
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.
Diffstat (limited to 'gcc/ada/sem_disp.adb')
| -rw-r--r-- | gcc/ada/sem_disp.adb | 15 |
1 files changed, 12 insertions, 3 deletions
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 |