Test suite results for test file test/units/system/tiorte.pp

Test run data :

Test file "test/units/system/tiorte.pp" information:

t_id 231
t_adddate 2003/10/03
t_result 0
t_knownrunerror 0

Detailed test run results:

Record count: 1

Log of 941031:

use_temp_dir set to false
verbose set to true
need_cwsdpmi set to true
Using DOSBOX executable: /home/muller/bin/dosbox
Using ./tiorte.exe
Using DosBoxDir=./
Using target dosbox.conf ./dosbox.conf
"copy_con_to_file=$wrapper_output" transformed into "copy_con_to_file=./dosbox.out"
"mount c $DosBoxDir" transformed into "mount c ./"
"$exit" transformed into "exit"
CopyFile "/home/muller/pas/gitlab-fpc-source/tests/utils/dosbox/exitcode.exe" -> "./EXITCODE.EXE"
CopyFile "./tiorte.exe" -> "./TEST.EXE"
CopyFile "LOG: Early LOG Init complete
LOG: DOSBox-X's working directory: /home/muller/pas/gitlab-fpc-source/tests/output/go32v2/test/units/system/chunk000000023test
LOG: Logging init: beginning logging proper. This is the end of the early init logging
LOG: Logging: opened logfile 'test_dosbox_x_logfile.txt' successfully. All further logging will go to this file.
LOG: DOSBox-X version 2023.10.06 Commit 59744fe (Linux SDL2 32-bit)
LOG: SDL: version 2.28.2, Video dummy, Audio dummy
LOG: Host keyboard layout is now  ()
LOG: Mapper keyboard layout is now  ()
LOG: SDL2 reports desktop display mode 1024 x 768
LOG: Configured windowposition: -
LOG: SDL: Current window pixel format: SDL_PIXELFORMAT_RGB888
LOG: SDL: You are running in 24 bpp mode, this will slow down things!
LOG: Screen report: Method 'None' (-1.000 x -1.000 pixels) at (0.000 x 0.000) (-1.000 x -1.000 mm) (-0.039 x -0.039 in) (-1.000 x -1.000 DPI)
LOG: ISA BCLK: 8333333.333Hz (25000000/3)
LOG: monopal: green, 
LOG: Active save slot: 1 [Empty]
LOG: USING AVI+ZMBV
LOG: Max 1048576 sz 16384
LOG: Final 16384
LOG: MIDI:Opened device:none
LOG: Pentium CMPXCHG8B emulation is enabled
LOG: Loaded language file: /home/muller/gnu/dosbox-x/contrib/translations/en/en_US.lng
LOG: VOODOO LFB now at d0000000
LOG: Serial1: BASE 3f8h
LOG: Serial2: BASE 2f8h
LOG: disney=true. For compatibility with other DOSBox forks and SVN, LPT1 has been reserved for Disney Sound Source. Initializing it now.
LOG: DOSBox-X also supports disney=false and parallel1=disney
LOG: Memory I/O complexity optimization enabled aka option 'memory io optimization 1'. If the game or demo is unable to draw to the screen properly, set the option to false.
LOG: The 'scanline render on demand' option is available and may provide a modest boost in video render performance if set to true.
LOG: Screen report: Method 'None' (-1.000 x -1.000 pixels) at (0.000 x 0.000) (-1.000 x -1.000 mm) (-0.039 x -0.039 in) (-1.000 x -1.000 DPI)
LOG: Allocated APM BIOS pm entry point at f000:ce40
LOG: Writing code to fce40
LOG: Writing code to fce60
LOG: Screen report: Method 'None' (-1.000 x -1.000 pixels) at (0.000 x 0.000) (-1.000 x -1.000 mm) (-0.039 x -0.039 in) (-1.000 x -1.000 DPI)
LOG: ISA Plug & Play BIOS enabled
LOG: VGA ROM BIOS init callback
LOG: pixratio 1.001, dw false, dh false
LOG: Aspect ratio: 640 x 480  xToY=1.333 yToX=0.750
LOG: menuScale=1
LOG: surface consider=640x497 final=640x497
LOG: Screen report: Method 'None' (-1.000 x -1.000 pixels) at (0.000 x 0.000) (-1.000 x -1.000 mm) (-0.039 x -0.039 in) (-1.000 x -1.000 DPI)
LOG: WARNING: No translation support (to host) for code page 0
LOG: XMS: 50 handles allocated for use by the DOS environment
LOG: EMS page frame at 0xe000-0xefff
LOG: COMMAND.COM env size:             720 bytes
LOG: COMMAND.COM environment block:    0x0701 sz=0x002d
LOG: COMMAND.COM main body (PSP):      0x072f sz=0x009a
LOG: COMMAND.COM stack:                0x0749
LOG: pixratio 1.350, dw false, dh false
LOG: Aspect ratio: 720 x 540  xToY=1.333 yToX=0.750
LOG: menuScale=1
LOG: surface consider=720x417 final=720x417
LOG: Screen report: Method 'None' (-1.000 x -1.000 pixels) at (0.000 x 0.000) (-1.000 x -1.000 mm) (-0.039 x -0.039 in) (-1.000 x -1.000 DPI)
/home/muller/bin/cwsdpmi.exe" -> "./CWSDPMI.EXE"
Starting /home/muller/bin/dosbox -conf dosbox.conf
Trying to open ./dosbox.out
Successfully opened ./dosbox.out, copying content to output
22: HAVE FUN WITH DOSBox-X !                                                       Drive C is mounted as local directory ./Reading from not opened text file... Passed!
23: Seekeoln from not opened text file... Passed!
24: Seekeof from not opened text file... Passed!
25: Reading from write-only (rewritten) text file... Passed!
26: Seekeoln from write-only (rewritten) text file... Passed!
27: Seekeof from write-only (rewritten) text file... Passed!
28: Reading from write-only (appended) text file... Passed!
29: Seekeoln from write-only (appended) text file... Passed!
30: Seekeof from write-only (appended) text file... Passed!
31: Reading from not opened typed file... Passed!
32: Reading from write-only typed file... Passed!
33: Reading from not opened untyped file... Passed!
34: Reading from write-only utyped file... Passed!
35: Writing to not opened text file... Passed!
36: Writing to read-only text file... Passed!
37: Writing to not opened typed file... Passed!
38: Writing to read-only typed file... Passed!
39: Writing to not opened untyped file... Passed!
40: Writing to read-only untyped file... Passed!
41: Testing closing of not opened text file... Passed!
42: Testing closing of not opened typed file... Passed!
43: Testing closing of not opened untyped file... Passed!
44: Testing change directory on non-existent file... Passed!
45: Testing make directory on already existent dir... Passed!
46: Testing erase of directory...Got 5 instead of 2
47:  Passed!
48: Testing remove directory of non-existent file...Got 3 instead of 2
49:  Passed!
50: Testing erase of non-existent file... Passed!
51: Trying to erase current directory... Passed!
52: Trying to erase parent directory...Got 16 instead of 5
53:  Passed!
54: Testing Filepos on non initialized file... Passed!
55: Testing Filesize on non initialized file... Passed!
ExitCode=1
Test finished with ExitCode=1

Source:

{ checks if the correct RTE's are generated for invalid io operations }

{$i-}

const
 TMP_DIRECTORY = 'temp2';
 has_fails : boolean = false;

procedure test(value, required: longint);
begin
  if value <> required then
    begin
      writeln('Got ',value,' instead of ',required);
      has_fails:=true;
      {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;



procedure test_fileroutines;
var
 F: File;
 L: longint;
begin
 { get the file position of a non-existent file }
 write('Testing Filepos on non initialized file...');
 l:=FilePos(F);
 test(IOresult,103);
 writeln(' Passed!');
 write('Testing Filesize on non initialized file...');
 l:=FileSize(F);
 test(IOresult,103);
 writeln(' Passed!');
end;

procedure test_directory;
var
 F: File;
{ test directory I/O }
begin
  { test on non-existant directory }
  write('Testing change directory on non-existent file...');
  ChDir('notexist');
  test(IOResult,3);
  { test on a file }
  ChDir('testdir.pas');
  test(IOResult,3);
  Writeln(' Passed!');
  { test on non-existant directory }
{$ifdef go32v2}
  ChDir('Y:	est.dir');
  test(IOResult,15);
{$endif}
  { make a stub directory for testing purposes }
  Mkdir(TMP_DIRECTORY);
  test(IOResult,0);
  { try to recreate the directory .... }
  write('Testing make directory on already existent dir...');
  MkDir(TMP_DIRECTORY);
  test(IOResult,5);
  Writeln(' Passed!');

  { try to erase the directory, using file access }
  write('Testing erase of directory...');
  Assign(F,TMP_DIRECTORY);
  Erase(F);
  test(IOResult,2);
  Writeln(' Passed!');
  { now really remove the directory }
  RmDir(TMP_DIRECTORY);
  test(IOResult,0);
  { remove non-existant directory }
  write('Testing remove directory of non-existent file...');
  RmDir('testdir.exe');
  { TP here returns 5 , not 2 }
  test(IOResult,2);
  Writeln(' Passed!');
  { erase non-existant file }
  write('Testing erase of non-existent file...');
  Assign(F,'notexist.txt');
  Erase(F);
  test(IOResult,2);
  WriteLn(' Passed!');
  { try to erase the current directory }
  write('Trying to erase current directory...');
  RmDir('.');
  test(IOResult, 16);
  WriteLn(' Passed!');
  { try to erase the previous directory }
  write('Trying to erase parent directory...');
  RmDir('..');
  test(IOResult, 5);
  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;
  test_directory;
  test_fileroutines;
  if has_fails then
    halt(1);
end.


{
 $Log: tiorte.pp,v $
 Revision 1.6  2002/10/15 12:05:49  pierre
 - * changed so that all tests are done even after a failure

 Revision 1.5  2002/09/07 15:40:56  peter
   * old logs removed and tabs fixed

 Revision 1.4  2002/03/09 23:17:35  carl
 * removing current directory should return 16

 Revision 1.3  2002/03/05 21:53:18  carl
 + tests on removing current directory and parent directory

}

Link to SVN view of test/units/system/tiorte.pp source.