Add testcase for PR ada/114398
gcc/testsuite/ PR ada/114398 * gnat.dg/access11.adb: New test.
This commit is contained in:
parent
a1bec0455f
commit
72a59a1b8d
1 changed files with 80 additions and 0 deletions
80
gcc/testsuite/gnat.dg/access11.adb
Normal file
80
gcc/testsuite/gnat.dg/access11.adb
Normal file
|
@ -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;
|
Loading…
Add table
Reference in a new issue