diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2024-06-10 11:44:24 +0200 |
---|---|---|
committer | Eric Botcazou <ebotcazou@adacore.com> | 2024-06-10 11:51:26 +0200 |
commit | 72a59a1b8d4e69b1faac93a31c1162ef0dbe53e5 (patch) | |
tree | 7205ba496557f08eec32c4fd3dbb9f91af331557 /gcc/testsuite/gnat.dg | |
parent | a1bec0455fb6f871bbc2c80d6e19c90deebbf824 (diff) | |
download | gcc-72a59a1b8d4e69b1faac93a31c1162ef0dbe53e5.zip gcc-72a59a1b8d4e69b1faac93a31c1162ef0dbe53e5.tar.gz gcc-72a59a1b8d4e69b1faac93a31c1162ef0dbe53e5.tar.bz2 |
Add testcase for PR ada/114398
gcc/testsuite/
PR ada/114398
* gnat.dg/access11.adb: New test.
Diffstat (limited to 'gcc/testsuite/gnat.dg')
-rw-r--r-- | gcc/testsuite/gnat.dg/access11.adb | 80 |
1 files changed, 80 insertions, 0 deletions
diff --git a/gcc/testsuite/gnat.dg/access11.adb b/gcc/testsuite/gnat.dg/access11.adb new file mode 100644 index 0000000..7c5a07c --- /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; |