paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-03 05:07:29 +01:00
Code Issues Packages Projects Releases Wiki Activity

+ inoutres test

Browse Source
This commit is contained in:
Jonas Maebe 2000-03-24 10:23:38 +00:00
parent ac43f97eba
commit f40d1d694d
2 changed files with 310 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

307
tests/test/inoutres.pp Normal file
View File

@ -0,0 +1,307 @@
{ 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.

4
tests/test/readme.txt
View File

@ -16,4 +16,6 @@ Parameter passing
via out ............... testout.pp via out ............... testout.pp
str/write(real_type) .. strreal.pp test correct rounding str/write(real_type) .. strreal.pp test correct rounding
strreal2.pp test correct writing of 10 till 1e-24 strreal2.pp test correct writing of 10 till 1e-24
input/output .......... inoutres.pp tests inoutres values of invalid
operations