aboutsummaryrefslogtreecommitdiff
path: root/gcc/testsuite/gnat.dg/access11.adb
blob: 7c5a07cf6fdb981f75ca63d81040e6c4794b64c2 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
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;