[gcc r15-1161] Add testcase for PR ada/114398

[Eric Botcazou]

https://gcc.gnu.org/g:e1c1f128d1c1e1f548cbae4eb014e455cfdfccc8

commit r15-1161-ge1c1f128d1c1e1f548cbae4eb014e455cfdfccc8
Author: Eric Botcazou <ebotcazou@adacore.com>
Date:   Mon Jun 10 11:44:24 2024 +0200

    Add testcase for PR ada/114398
    
    gcc/testsuite/
            PR ada/114398
            * gnat.dg/access11.adb: New test.

Diff:
---
 gcc/testsuite/gnat.dg/access11.adb | 80 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 80 insertions(+)

diff --git a/gcc/testsuite/gnat.dg/access11.adb b/gcc/testsuite/gnat.dg/access11.adb
new file mode 100644
index 00000000000..7c5a07cf6fd
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/access11.adb
@@ -0,0 +1,80 @@
+--  PR ada/114398
+--  Testcase by Dennis van Raaij <d.van.raaij@gmail.com>
+
+--  { dg-do run }
+
+with Ada.Finalization;
+
+procedure Access11 is
+
+   package Pkg is
+
+      type Int is
+        new Ada.Finalization.Limited_Controlled
+      with record
+         Value : Integer;
+      end record;
+
+      procedure Set (This : out Int; To : Integer);
+      procedure Set (This : out Int; To : Int);
+
+      function "+" (Left, Right : Int) return Int;
+
+      overriding procedure Initialize (This : in out Int);
+      overriding procedure Finalize   (This : in out Int);
+
+   end Pkg;
+
+   package body Pkg is
+
+      procedure Set (This : out Int; To : Integer) is
+      begin
+         This.Value := To;
+      end Set;
+
+      procedure Set (This  : out Int; To : Int) is
+      begin
+         This.Value := To.Value;
+      end Set;
+
+      function "+" (Left, Right : Int) return Int is
+      begin
+         return Result : Int do
+            Result.Value := Left.Value + Right.Value;
+         end return;
+      end "+";
+
+      overriding procedure Initialize (This : in out Int) is
+      begin
+         This.Value := 42;
+      end Initialize;
+
+      overriding procedure Finalize (This : in out Int) is
+      begin
+         This.Value := 0;
+      end Finalize;
+
+   end Pkg;
+
+   use Pkg;
+
+   type Binary_Operator is access
+     function (Left, Right : Int) return Int;
+
+   procedure Test
+     (Op          : Binary_Operator;
+      Left, Right : Int)
+   is
+      Result : Int;
+   begin
+      Result.Set (Op (Left, Right));
+   end Test;
+
+   A, B : Int;
+
+begin
+   A.Set (7);
+   B.Set (9);
+
+   Test ("+"'Access, A, B);
+end;