blob: 829097f41f7eebb38927b00280bc24c6c5c159a5 (
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
|
{$MODE MACPAS}
{Tests of mac pascal constructs}
program tmacpas2;
var
success: Boolean = true;
type
{Since we do not want to compile in the whole mac api, we
simulate decl of FourCharCode here:}
MyFourCharCodeType = Longword;
procedure Proc;
begin
{** Exit with proc name as argument **}
Exit(Proc);
end;
procedure TestFourCharCode(myFCC: MyFourCharCodeType);
begin
Writeln('FPC creator code as number: ', hexstr(myFCC,8));
if myFCC <> $46506173 then
success := false;
end;
const
myFCCconst = 'FPas'; {Free Pascals Creator code :) }
var
p: pointer;
l,i: longint;
a,b,c : Boolean;
begin
a := true;
b := true;
c := false;
{** Test & and | as alias for AND and OR **}
if not (a & b) then
success:= false;
if not (c | b) then
success:= false;
{** Test that Ord() can take pointer values **}
p:= pointer(4711);
l:= Ord(p);
if l <> 4711 then
success:= false;
{** Test cycle and leave **}
i:= 0;
while true do
begin
i:= i+1;
if i = 1 then
Cycle;
Leave;
end;
if i<> 2 then
success:= false;
{** Does literal four char codes work**}
{Both directly and indirectly}
TestFourCharCode('FPas');
TestFourCharCode(myFCCconst);
if success then
Writeln('Whole test succeded')
else
begin
Writeln('Whole test failed');
halt(1);
end;
end.
|
