From: Ronan Desplanques <desplanq...@adacore.com> This patch improves the way controlling access parameters are handled in dispatch table wrappers. The constructions of both the specifications and the bodies of wrappers are modified.
gcc/ada/ * freeze.adb (Build_DTW_Body): Add appropriate type conversions for controlling access parameters. * sem_util.adb (Build_Overriding_Spec): Fix designated types in controlling access parameters. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/freeze.adb | 7 ++----- gcc/ada/sem_util.adb | 7 +++++-- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 6014f71e661..1a1eace600b 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1555,7 +1555,6 @@ package body Freeze is Par_Prim : Entity_Id; Wrapped_Subp : Entity_Id) return Node_Id is - Par_Typ : constant Entity_Id := Find_Dispatching_Type (Par_Prim); Actuals : constant List_Id := Empty_List; Call : Node_Id; Formal : Entity_Id := First_Formal (Par_Prim); @@ -1571,12 +1570,10 @@ package body Freeze is -- If the controlling argument is inherited, add conversion to -- parent type for the call. - if Etype (Formal) = Par_Typ - and then Is_Controlling_Formal (Formal) - then + if Is_Controlling_Formal (Formal) then Append_To (Actuals, Make_Type_Conversion (Loc, - New_Occurrence_Of (Par_Typ, Loc), + New_Occurrence_Of (Etype (Formal), Loc), New_Occurrence_Of (New_Formal, Loc))); else Append_To (Actuals, New_Occurrence_Of (New_Formal, Loc)); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index b28f2899894..2e2fb911c38 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -2234,9 +2234,12 @@ package body Sem_Util is and then Entity (Formal_Type) = Par_Typ then Rewrite (Formal_Type, New_Occurrence_Of (Typ, Loc)); - end if; - -- Nothing needs to be done for access parameters + elsif Nkind (Formal_Type) = N_Access_Definition + and then Entity (Subtype_Mark (Formal_Type)) = Par_Typ + then + Rewrite (Subtype_Mark (Formal_Type), New_Occurrence_Of (Typ, Loc)); + end if; Next (Formal_Spec); end loop; -- 2.40.0