blob: e9da58bb15a7c3def8e94de4f5759cfd13338e27 (
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
|
program E03;
{$IFDEF FPC}
{$MODE DELPHI}
{$ENDIF}
{$APPTYPE CONSOLE}
type
T0 = class
class procedure Foo;
end;
TA = class(T0)
class procedure Foo(A: Integer = 0); overload; virtual;
end;
TB = class(TA)
class procedure Foo(A: Integer); overload; override;
end;
TClassB = class of TB;
var
t0called,
tacalled,
tbcalled: boolean;
class procedure T0.Foo();
begin
WriteLn('T0.Foo');
t0called:=true;
end;
class procedure TA.Foo(A: Integer = 0);
begin
WriteLn('TA.Foo');
tacalled:=true;
end;
class procedure TB.Foo(A: Integer);
begin
WriteLn('TB.Foo');
tbcalled:=true;
end;
var
B: TB;
ClassB: TClassB;
begin
TB.Foo; // call TA.Foo (VMT is not used, compiler can determine) -- on Delphi
// on FPC: call TB.Foo because virtual method and VMT specified
if t0called then
halt(1);
if tacalled then
halt(2);
if not tbcalled then
halt(3);
tbcalled:=false;
B := TB.Create;
B.Foo; // call TB.Foo because of VMT rules
B.Free;
if t0called then
halt(4);
if tacalled then
halt(5);
if not tbcalled then
halt(6);
tbcalled:=false;
ClassB := TB;
ClassB.Foo; // call TB.Foo because of VMT rules
if t0called then
halt(7);
if tacalled then
halt(8);
if not tbcalled then
halt(9);
tbcalled:=false;
end.
|
