From: Ronan Desplanques <desplanques@adacore.com>
Date: Fri, 3 Mar 2023 14:21:16 +0000 (+0100)
Subject: ada: Handle controlling access parameters in DTWs
X-Git-Tag: basepoints/gcc-15~8937
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=211b562b74bdad3d3c3571517699f35540be8391;p=thirdparty%2Fgcc.git

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.
---

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 6014f71e661e..1a1eace600bb 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 b28f28998946..2e2fb911c388 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;