fpcsrc/tests/tbs/tb0496.pp


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

{$mode delphi}
type
  tmyclass = class
    procedure m1;virtual;
    procedure m2;virtual;
  end;

  tm1 = procedure of object;

var
  res : longint;

procedure tmyclass.m1;
  begin
    res:=1;
  end;

procedure p2(m1 : tm1);
  begin
    m1;
  end;

procedure tmyclass.m2;
  begin
    p2(m1);
  end;

var
  myclass : tmyclass;
begin
  res:=$deadbeef;
  myclass:=tmyclass.create;
  myclass.m2;
  myclass.free;
  if res<>1 then
    halt(1);
  writeln('ok');
end.