+ inoutres test

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.

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
+                        strreal2.pp    test correct writing of 10 till 1e-24
+input/output .......... inoutres.pp    tests inoutres values of invalid
+                                       operations