blob: 79ae77a88c59f26345da2dc123bdd3f667e728c9 (
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
|
{****************************************************************}
{ CODE GENERATOR TEST PROGRAM }
{****************************************************************}
{ NODE TESTED : secondis() }
{****************************************************************}
{ PRE-REQUISITES: secondload() }
{ secondassign() }
{ secondcalln() }
{ secondinline() }
{ secondadd() }
{****************************************************************}
{ DEFINES: }
{****************************************************************}
{ REMARKS: }
{****************************************************************}
program tis;
{$mode objfpc}
type
{$ifndef fpc}
smallint = integer;
{$endif}
tclass1 = class
end;
tclass2 = class(tclass1)
end;
tclass3 = class
end;
var
myclass1 : tclass1;
myclass2 : tclass2;
myclass3 : tclass3;
class1 : class of tclass1;
procedure fail;
begin
WriteLn('Failure.');
halt(1);
end;
function getclass1 : tclass1;
begin
getclass1:=myclass1;
end;
function getclass2 : tclass2;
begin
getclass2:=myclass2;
end;
function getclass3 : tclass3;
begin
getclass3:=myclass3;
end;
{ possible types : left : LOC_REFERENCE, LOC_REGISTER }
{ possible types : right : LOC_REFERENCE, LOC_REGISTER }
var
failed : boolean;
myclass4 : class of tclass1;
begin
failed := false;
{ create class instance }
myclass1:=tclass1.create;
myclass2:=tclass2.create;
myclass3:=tclass3.create;
{if myclass1 is tclass1 }
Write('Testing left/right : LOC_REGISTER/LOC_REGISTER...');
if not(getclass1 is tclass1) then
failed := true;
if (getclass1 is tclass2) then
failed := true;
if not (getclass2 is tclass2) then
failed := true;
if (getclass1 is tclass2) then
failed := true;
if failed then
Fail
else
WriteLn('Passed!');
failed := false;
Write('Testing left/right : LOC_REFERENCE/LOC_REGISTER...');
if not(myclass1 is tclass1) then
failed := true;
if (myclass1 is tclass2) then
failed := true;
if not (myclass2 is tclass2) then
failed := true;
if (myclass1 is tclass2) then
failed := true;
if failed then
Fail
else
WriteLn('Passed!');
failed := false;
Write('Testing left/right : LOC_REFERENCE/LOC_REFERENCE...');
if (myclass1 is class1) then
failed := true;
if failed then
Fail
else
WriteLn('Passed!');
end.
|
