tests/tbs/tb0486.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
39
40

{$ifdef fpc}{$mode delphi}{$endif}
type
  tprocedure = procedure;
  pprocedure = ^tprocedure;

var
  l : longint;
  l2 : tprocedure;

function _f1 : plongint;
  begin
    result:=@l;
  end;

function _f2 : pprocedure;
  begin
    result:=@@l2;
  end;

var
  f1 : function : plongint;
  f2 : function : pprocedure;

procedure p;
  begin
    l:=2;
  end;

begin
  f1:=_f1;
  f2:=_f2;
  f1^:=1;
  if l<>1 then
    halt(1);
  f2^:=p;
  f2^;
  if l<>2 then
    halt(1);
  writeln('ok');
end.