blob: e1e349a1271181297044c2296ceb662405f5e2d0 (
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
|
{ Source provided for Free Pascal Bug Report 1622 }
{ Submitted by "Henrik C. Jessen" on 2001-09-28 }
{ e-mail: henrik.jessen@nettest.com }
PROGRAM Test;
{$ifdef go32v2}
CONST
SomeSegment = $B800;
SomeOffset = $0000;
VAR
AbsOne : Word ABSOLUTE $B800:$0000;
{ -- accepted by FPC }
AbsTwo : Word ABSOLUTE SomeSegment:SomeOffset;
{ -- NOT accepted by FPC }
AbsThree : Word ABSOLUTE $B000+$400*2:24*16+4-32;
AbsFour : Word ABSOLUTE SomeSegment+$400*2:SomeOffset*4-32;
{ The two variables above are at the same }
{ address; that is correctly recognized }
{ by Borland Pascal. }
{-----------------------------------------}
{$endif go32v2}
{ Adding some test code for normal absolute stuff }
procedure testabs(var x : longint);
var
y : longint absolute x;
begin
y:=x+1;
end;
{ If x is diclared as const parametr
the compilation should fail }
procedure testabs2({const }x : longint);
var
y : longint absolute x;
begin
y:=x+1;
end;
procedure teststring(s : string);
var
y : byte absolute s;
begin
{ this will truncate the string to 4 chars }
y:=4;
Writeln(s);
end;
procedure teststringvar(var s : string);
var
y : byte absolute s;
begin
{ this will truncate the string to 4 chars }
y:=4;
Writeln(s);
end;
procedure test_global_var;
var
y : longint absolute system.exitcode;
begin
y := 315;
end;
const
x : longint = 5;
y : longint = 7;
var
s : string;
BEGIN
testabs(x);
if x<>6 then
begin
Writeln('Error in absolute handling');
Halt(1);
end;
testabs2(y);
if y<>7 then
begin
Writeln('Error in absolute handling');
Halt(1);
end;
s:='Test dummy string';
teststring(s);
if s<>'Test dummy string' then
begin
Writeln('Error in absolute handling for strings');
Halt(1);
end;
teststringvar(s);
if s<>'Test' then
begin
Writeln('Error in absolute handling for strings');
Halt(1);
end;
test_global_var;
if exitcode<>315 then
begin
Writeln('Error in absolute handling');
Halt(1);
end;
exitcode:=0;
END.
|