diff mbox series

[COMMITTED] ada: Handle controlling access parameters in DTWs

Message ID 20230525080531.1955918-1-poulhies@adacore.com
State Accepted
Headers
Series [COMMITTED] ada: Handle controlling access parameters in DTWs |

Checks

Context Check Description
snail/gcc-patch-check success Github commit url

Commit Message

Marc Poulhiès May 25, 2023, 8:05 a.m. UTC 
  From: Ronan Desplanques <desplanques@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 mbox series

Patch

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;