blob: 0668b6e9761e5fca1ece7830f2601d6e3f3f8482 (
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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
{$mode objfpc}
type
tbaseclass = class
x : longint;
class procedure virtual_class_method; virtual;
class procedure call_virtual_class_method;
end;
tderivedclass = class(tbaseclass)
y : longint;
class procedure virtual_class_method; override;
end;
const
tbasecalled : boolean = false;
tderivedcalled : boolean = false;
has_error : boolean = false;
class procedure tbaseclass.virtual_class_method;
begin
Writeln('Calling tbase class class method');
tbasecalled:=true;
end;
class procedure tbaseclass.call_virtual_class_method;
begin
virtual_class_method;
end;
class procedure tderivedclass.virtual_class_method;
begin
Writeln('Calling tderived class class method');
tderivedcalled:=true;
end;
procedure reset_booleans;
begin
tbasecalled:=false;
tderivedcalled:=false;
end;
var
c1,cb : tbaseclass;
cd : tderivedclass;
cc : class of tbaseclass;
begin
cb:=tbaseclass.create;
cd:=tderivedclass.create;
c1:=tbaseclass.create;
tbaseclass.virtual_class_method;
if not tbasecalled then
has_error:=true;
reset_booleans;
tbaseclass.call_virtual_class_method;
if not tbasecalled then
has_error:=true;
reset_booleans;
tderivedclass.virtual_class_method;
if not tderivedcalled then
has_error:=true;
reset_booleans;
tderivedclass.call_virtual_class_method;
if not tderivedcalled then
has_error:=true;
reset_booleans;
c1.virtual_class_method;
if not tbasecalled then
has_error:=true;
reset_booleans;
c1.call_virtual_class_method;
if not tbasecalled then
has_error:=true;
reset_booleans;
c1.destroy;
c1:=tderivedclass.create;
c1.virtual_class_method;
if not tderivedcalled then
has_error:=true;
reset_booleans;
c1.call_virtual_class_method;
if not tderivedcalled then
has_error:=true;
reset_booleans;
c1.destroy;
cc:=tbaseclass;
cc.virtual_class_method;
if not tbasecalled then
has_error:=true;
reset_booleans;
cc.call_virtual_class_method;
if not tbasecalled then
has_error:=true;
reset_booleans;
cc:=tderivedclass;
cc.virtual_class_method;
if not tderivedcalled then
has_error:=true;
reset_booleans;
cc.call_virtual_class_method;
if not tderivedcalled then
has_error:=true;
reset_booleans;
if has_error then
begin
Writeln('Error with class methods');
halt(1);
end;
end.
|
