paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 01:29:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

no message

Browse Source
This commit is contained in:
carl 2001-05-09 21:11:31 +00:00
parent 68c1559651
commit e51a3f73a9
1 changed files with 0 additions and 307 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

307
tests/test/tinoutres.pp
View File

@ -1,307 +0,0 @@
{ checks if the correct RTE's are generated for invalid io operations }
{$i-}
procedure test(value, required: longint);
begin
if value <> required then
begin
writeln('Got ',value,' instead of ',required);
halt(1);
end;
end;
procedure test_read_text;
var
f: text;
s: string;
begin
{ to avoid influence of previous runs/procedures }
fillchar(f,sizeof(f),0);
write('Reading from not opened text file...');
read(f,s);
test(ioresult,103);
readln(f);
test(ioresult,103);
writeln(' Passed!');
write('Seekeoln from not opened text file...');
seekeoln(f);
test(ioresult,103);
writeln(' Passed!');
write('Seekeof from not opened text file...');
seekeof(f);
test(ioresult,103);
writeln(' Passed!');
assign(f,'inoutrte.$$$');
rewrite(f);
test(ioresult,0);
write('Reading from write-only (rewritten) text file...');
read(f,s);
test(ioresult,104);
readln(f);
test(ioresult,104);
writeln(' Passed!');
write('Seekeoln from write-only (rewritten) text file...');
seekeoln(f);
test(ioresult,104);
writeln(' Passed!');
write('Seekeof from write-only (rewritten) text file...');
seekeof(f);
test(ioresult,104);
writeln(' Passed!');
close(f);
test(ioresult,0);
append(f);
test(ioresult,0);
write('Reading from write-only (appended) text file...');
read(f,s);
test(ioresult,104);
readln(f);
test(ioresult,104);
writeln(' Passed!');
write('Seekeoln from write-only (appended) text file...');
seekeoln(f);
test(ioresult,104);
writeln(' Passed!');
write('Seekeof from write-only (appended) text file...');
seekeof(f);
test(ioresult,104);
writeln(' Passed!');
close(f);
test(ioresult,0);
erase(f);
test(ioresult,0);
end;
procedure test_read_typed;
var
f: file of byte;
s: byte;
begin
{ to avoid influence of previous runs/procedures }
fillchar(f,sizeof(f),0);
write('Reading from not opened typed file...');
read(f,s);
test(ioresult,103);
writeln(' Passed!');
{ with filemode 2, the file is read-write }
filemode := 1;
assign(f,'inoutrte.$$$');
rewrite(f);
test(ioresult, 0);
write(f,s);
test(ioresult, 0);
close(f);
test(ioresult, 0);
reset(f);
test(ioresult, 0);
write('Reading from write-only typed file...');
read(f,s);
test(ioresult,104);
writeln(' Passed!');
filemode := 2;
close(f);
test(ioresult, 0);
erase(f);
test(ioresult, 0);
end;
procedure test_read_untyped;
var
f: file;
r: longint;
s: byte;
begin
{ to avoid influence of previous runs/procedures }
fillchar(f,sizeof(f),0);
write('Reading from not opened untyped file...');
blockread(f,s,1,r);
test(ioresult,103);
writeln(' Passed!');
{ with filemode 2, the file is read-write }
filemode := 1;
assign(f,'inoutrte.$$$');
rewrite(f);
test(ioresult, 0);
blockwrite(f,s,1);
test(ioresult, 0);
close(f);
test(ioresult, 0);
reset(f);
test(ioresult, 0);
write('Reading from write-only utyped file...');
blockread(f,s,1,r);
test(ioresult,104);
writeln(' Passed!');
filemode := 2;
close(f);
test(ioresult, 0);
erase(f);
test(ioresult, 0);
end;
procedure test_write_text;
var f: text;
s: string;
begin
{ to avoid influence of previous runs/procedures }
fillchar(f,sizeof(f),0);
write('Writing to not opened text file...');
write(f,s);
test(ioresult,103);
writeln(f);
test(ioresult,103);
writeln(' Passed!');
assign(f,'inoutrte.$$$');
rewrite(f);
close(f);
test(ioresult,0);
reset(f);
test(ioresult,0);
write('Writing to read-only text file...');
write(f,s);
test(ioresult,105);
writeln(f);
test(ioresult,105);
Writeln(' Passed!');
close(f);
test(ioresult,0);
erase(f);
test(ioresult,0);
end;
procedure test_write_typed;
var f: file of byte;
s: byte;
begin
{ to avoid influence of previous runs/procedures }
fillchar(f,sizeof(f),0);
write('Writing to not opened typed file...');
write(f,s);
test(ioresult,103);
writeln(' Passed!');
assign(f,'inoutrte.$$$');
rewrite(f);
close(f);
test(ioresult,0);
filemode := 0;
reset(f);
test(ioresult,0);
write('Writing to read-only typed file...');
write(f,s);
test(ioresult,105);
Writeln(' Passed!');
filemode := 2;
close(f);
test(ioresult,0);
erase(f);
test(ioresult,0);
end;
procedure test_write_untyped;
var f: file;
r: longint;
s: byte;
begin
{ to avoid influence of previous runs/procedures }
fillchar(f,sizeof(f),0);
write('Writing to not opened untyped file...');
blockwrite(f,s,1,r);
test(ioresult,103);
writeln(' Passed!');
assign(f,'inoutrte.$$$');
rewrite(f);
close(f);
test(ioresult,0);
filemode := 0;
reset(f);
test(ioresult,0);
write('Writing to read-only untyped file...');
blockwrite(f,s,1,r);
test(ioresult,105);
Writeln(' Passed!');
filemode := 2;
close(f);
test(ioresult,0);
erase(f);
test(ioresult,0);
end;
procedure test_close_text;
var f: text;
begin
{ to avoid influence of previous runs/procedures }
fillchar(f,sizeof(f),0);
write('Testing closing of not opened text file...');
close(f);
test(ioresult,103);
writeln(' Passed!');
end;
procedure test_close_typed;
var f: file of byte;
begin
{ to avoid influence of previous runs/procedures }
fillchar(f,sizeof(f),0);
write('Testing closing of not opened typed file...');
close(f);
test(ioresult,103);
writeln(' Passed!');
end;
procedure test_close_untyped;
var f: file;
begin
{ to avoid influence of previous runs/procedures }
fillchar(f,sizeof(f),0);
write('Testing closing of not opened untyped file...');
close(f);
test(ioresult,103);
writeln(' Passed!');
end;
begin
test_read_text;
test_read_typed;
test_read_untyped;
test_write_text;
test_write_typed;
test_write_untyped;
test_close_text;
test_close_typed;
test_close_untyped;
end.