aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRonan Desplanques <desplanques@adacore.com>2023-03-03 15:21:16 +0100
committerMarc Poulhiès <poulhies@adacore.com>2023-05-25 09:44:15 +0200
commit211b562b74bdad3d3c3571517699f35540be8391 (patch)
tree9c52b1b53f474f0494eeabd6592090effdfcd83a
parentf26005d533d5ecd25cb95f2bb542cd77a51ea418 (diff)
downloadgcc-211b562b74bdad3d3c3571517699f35540be8391.zip
gcc-211b562b74bdad3d3c3571517699f35540be8391.tar.gz
gcc-211b562b74bdad3d3c3571517699f35540be8391.tar.bz2
ada: Handle controlling access parameters in DTWs
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.
-rw-r--r--gcc/ada/freeze.adb7
-rw-r--r--gcc/ada/sem_util.adb7
2 files changed, 7 insertions, 7 deletions
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 6014f71..1a1eace 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 b28f289..2e2fb91 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;