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
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
{$i+}
{ Widestring is not supported in 1.0.x }
{$ifndef VER1_0}
{$define HASWIDESTR}
{$endif VER1_0}
function getint64_1 : int64;
var
value : longint;
begin
value:=1;
getint64_1 := int64(value) shl 40;
end;
function getint64_2 : int64;
var
value : longint;
begin
value:=65535;
getint64_2 := value;
end;
procedure test_rwtext;
var
t: text;
s: shortstring;
a: ansistring;
{$ifdef HASWIDESTR}
wc : widechar;
w : widestring;
{$endif HASWIDESTR}
l: longint;
card: cardinal;
b: byte; bool: boolean;
c: char;
arr: array[1..10] of char;
p: pchar;
r: real;
vl : int64;
vl1 : int64;
tmplong : longint;
begin
bool := true;
writeln('ShortString const test');
writeln('ShortString const test with const len':70);
b := 60;
writeln('ShortString const test with var len':b);
s := 'ShortStr var test';
writeln(s);
s := s+ ' with const len';
writeln(s:40);
s := 'ShortStr var test with var len';
writeln(s:b);
l := -1; c := 'y'; card := 18; r := 5.1234;
writeln('A combo test: ',b,' ',l,' ',c,' ',card,' ',bool:10);
writeln('floats: ',r,' ',r:1,' ',r:8,' ',r:10:2);
arr := 'arrofchars';
writeln('array of char: ',arr:38);
arr[10] := #0;
p := @arr;
writeln('pchar test: ',p);
a := 'this is an ansistring';
writeln(a);
vl:=getint64_1;
vl1:=getint64_2;
writeln('int64 test : ',vl, ' ',vl1);
{$ifdef HASWIDESTR}
wc := 'y';
writeln('widechar: ',wc);
w := 'this is a widestring';
writeln(w);
{$endif HASWIDESTR}
write('no new line now...',l,c,b);
write;
read;
assign(t,'treadwrt.txt');
rewrite(t);
writeln('testing text file functionality...');
writeln(t,'this is a string');
writeln(t,l);
writeln(t,c);
writeln(t,b);
writeln(t,vl);
writeln(t,vl1);
l := 0;
c := #32;
b := 5;
vl:=1;
vl1 := 2;
close(t);
reset(t);
readln(t,s);
if s <> 'this is a string' then
halt(1);
readln(t,l);
if l <> -1 then
halt(1);
readln(t,c);
if c <> 'y' then
halt(1);
readln(t,b);
if b <> 60 then
halt(1);
{ 64-bit read testing }
readln(t,vl);
if vl <> getint64_1 then
halt(1);
readln(t,vl1);
if vl1 <> getint64_2 then
halt(1);
close(t);
erase(t);
writeln('write/read text passed...');
end;
procedure test_rwtyped;
var
f: file of cardinal;
c: cardinal;
begin
assign(f,'treadwrt.dat');
rewrite(f);
c := 8;
write(f,c);
write(f,cardinal(10));
close(f);
reset(f);
read(f,c);
if c <> 8 then
halt(1);
read(f,c);
if c <> 10 then
halt(1);
close(f);
erase(f);
writeln('write/read typed passed...');
end;
begin
test_rwtext;
test_rwtyped;
end.
|
