diff --git a/tests/test/inoutres.pp b/tests/test/inoutres.pp new file mode 100644 index 0000000000..911a70afcc --- /dev/null +++ b/tests/test/inoutres.pp @@ -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. diff --git a/tests/test/readme.txt b/tests/test/readme.txt index 56c32eaaaa..3e9db1f3c7 100644 --- a/tests/test/readme.txt +++ b/tests/test/readme.txt @@ -16,4 +16,6 @@ Parameter passing via out ............... testout.pp str/write(real_type) .. strreal.pp test correct rounding - strreal2.pp test correct writing of 10 till 1e-24 \ No newline at end of file + strreal2.pp test correct writing of 10 till 1e-24 +input/output .......... inoutres.pp tests inoutres values of invalid + operations