t_id
250
t_adddate
2003/10/03
t_result
0
t_knownrunerror
0
| tr_id | run | tr_ok | tr_skip | tr_result |
|---|---|---|---|---|
| 479875195 | 940804 | False | False | Failed to run |
Record count: 1
use_temp_dir set to false
verbose set to true
need_cwsdpmi set to true
Using DOSBOX executable: /home/muller/bin/dosbox
Using ./tdos2.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-fixes/tests/utils/dosbox/exitcode.exe" -> "./EXITCODE.EXE"
CopyFile "./tdos2.exe" -> "./TEST.EXE"
CopyFiLOG: Early LOG Init complete
LOG: DOSBox-X's working directory: /home/muller/pas/gitlab-fpc-source-fixes/tests/output/go32v2/test/units/dos/chunk000000018test
LOG: Logging init: beginning logging proper. This is the end of the early init logging
LOG: Logging: No logfile was given. All further logging will be discarded.
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
ALSA lib seq_hw.c:466:(snd_seq_hw_open) open /dev/snd/seq failed: Permission denied
LOG: MT32: failed to locate ROMs.
LOG: MT32 emulation requires the PCM and CONTROL ROM files.
LOG: To eliminate this error message, check the DOSBox-X wiki.
LOG: The ROM files are: CM32L_CONTROL.ROM and CM32L_PCM.ROM or MT32_CONTROL.ROM and MT32_PCM.ROM
LOG: MIDI:Opened device:none
LOG: Pentium CMPXCHG8B emulation is enabled
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: MPU-401 Registering I/O ports as if IBM PC MPU-401 at base 330h
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: 1466977 ERROR BIOS:Keyboard layout file auto not found
LOG: 1466977 ERROR BIOS:Keyboard layout file auto not found
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)
le "/home/muller/bin/cwsdpmi.exe" -> "./CWSDPMI.EXE"
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 ./----------------------------------------------------------------------
23: GETDATE
24: ----------------------------------------------------------------------
25: Note: Number of week should be consistent (0 = Sunday)
26: Note: Year should contain full four digits.
27: ----------------------------------------------------------------------
28: Verifying value of DOS Error...Success.
29: Verifying value of DOS Error...Success.
30: DD-MM-YYYY : 28-4-2024 (Sunday)
31: ----------------------------------------------------------------------
32: SETDATE
33: ----------------------------------------------------------------------
34: Verifying value of DOS Error...Success.
35: Verifying value of DOS Error...Success.
36: Verifying value of DOS Error...Success.
37: Testing with invalid year....Success.
38: Verifying value of DOS Error...Success.
39: Verifying value of DOS Error...Success.
40: Testing with invalid day.....Success.
41: Verifying value of DOS Error...Success.
42: Verifying value of DOS Error...Success.
43: Testing with invalid month...Success.
44: ----------------------------------------------------------------------
45: Note: Date should be 01-01-1998
46: ----------------------------------------------------------------------
47: Verifying value of DOS Error...Success.
48: Verifying value of DOS Error...Success.
49: DD-MM-YYYY : 1-1-1998
50: Verifying value of DOS Error...Success.
51: ----------------------------------------------------------------------
52: Note: Date should be restored to previous value
53: ----------------------------------------------------------------------
54: Verifying value of DOS Error...Success.
55: DD-MM-YYYY : 28-4-2024
56: ----------------------------------------------------------------------
57: GETTIME
58: ----------------------------------------------------------------------
59: Note: Hours should be in military format (0..23), and MSec in 0..100
60: ----------------------------------------------------------------------
61: Verifying value of DOS Error...Success.
62: Verifying value of DOS Error...Success.
63: HH:MIN:SEC (MS): 4:6:52 (11)
64: ----------------------------------------------------------------------
65: SETTIME
66: ----------------------------------------------------------------------
67: Note: GetTime should return the same value as the previous test.
68: ----------------------------------------------------------------------
69: Verifying value of DOS Error...Success.
70: Verifying value of DOS Error...Success.
71: HH:MIN:SEC 4:6:52
72: Verifying value of DOS Error...Success.
73: Verifying value of DOS Error...Success.
74: HH:MIN:SEC 4:0:52
75: ----------------------------------------------------------------------
76: Note: GetTime should return 0:0:0
77: ----------------------------------------------------------------------
78: Verifying value of DOS Error...Success.
79: Verifying value of DOS Error...Success.
80: HH:MIN:SEC 0:0:0
81: ----------------------------------------------------------------------
82: Note: GetTime should return approximately the original time
83: ----------------------------------------------------------------------
84: Verifying value of DOS Error...Success.
85: Verifying value of DOS Error...Success.
86: HH:MIN:SEC 4:6:51
87: ----------------------------------------------------------------------
88: GETFTIME / SETFTIME
89: ----------------------------------------------------------------------
90: Verifying value of DOS Error...Success.
91: Assigning an invalid file...Verifying value of DOS Error...Success.
92: Trying to open TESTDOS.DAT...Verifying value of DOS Error...Success.
93: ----------------------------------------------------------------------
94: Note: Hour should be in military format and year should be a 4 digit
95: number.
96: ----------------------------------------------------------------------
97: DD-MM-YYYY : 28-4-2024
98: HH:MIN:SEC 4:6:50
99: Verifying value of DOS Error...Success.
100: Verifying value of DOS Error...Success.
101: Verifying value of DOS Error...Success.
102: Setting TESTDOS.DAT date/time to 01-28-1998:0:0:0...FAILURE.
103: Verifying value of DOS Error...Success.
104: Verifying value of DOS Error...Success.
105: Verifying value of DOS Error...Success.
106: Restoring old file time stamp...Success.
107: ----------------------------------------------------------------------
108: Running LFN tests
109: ----------------------------------------------------------------------
110: ----------------------------------------------------------------------
111: FINDFIRST/ FINDNEXT
112: ----------------------------------------------------------------------
113: Note: The full path should NOT be displayed.
114: ----------------------------------------------------------------------
115: Verifying value of DOS Error...Success.
116: Trying to find an invalid file ('') with Any Attribute...
117: Verifying value of DOS Error...FAILURE. (Value should be 3 (2): File not found.)
118: Trying to find an invalid file ('') with VolumeID attribute...
119: Verifying value of DOS Error...FAILURE. (Value should be 3 (2): File not found.)
120: Trying to find an invalid file (''zz.dat'') with Any Attribute...
121: Verifying value of DOS Error...Success.
122: Trying to find an invalid file (''zz.dat'') with VolumeID attribute...
123: Verifying value of DOS Error...Success.
124: Trying to find an invalid file (''zz.dat'') with Directory attribute...
125: Verifying value of DOS Error...Success.
126: Looking for TESTDOS.DAT with Any Attribute...Success.
127: Looking for TESTDOS.DAT with Directory Attribute...Success.
128: Checking file stats of TESTDOS.DAT...Success.
129: Looking for TESTDOS.DAT...Success.
130: Checking file stats of TESTDOS.DAT...Success.
131: Resources found (full path should not be displayed):
132: .
133: ..
134: MYDIR
135: TESTFILE
136: Searching using * wildcard (normal files + directories)...Success.
137: Resources found (full path should not be displayed):
138:
139: .
140: ..
141: Searching using ??? wildcard (normal files + all special files)...Success.
142: Resources found (full path should not be displayed):
143: Volume ID:
144: .
145: ..
146: MYDIR
147: CWSDPMI.EXE
148: CWSDPMI.SWP
149: DOSBOX.OUT
150: DOSBOX~1.CON
151: EXITCODE.EXE
152: TBREAK.EXE
153: TBREAK.O
154: TDOS.EXE
155: TDOS.O
156: TDOS2.EXE
157: TDOS2.O
158: TEST.EXE
159: TESTDOS.DAT
160: TESTFILE
161: Searching using *.* wildcard in ROOT (normal files + volume ID)...Success.
162: ----------------------------------------------------------------------
163: FSPLIT
164: ----------------------------------------------------------------------
165: Testing invalid filename...Success.
166: Testing paramstr(0)...Success.
167: Testing paramstr(0)...Success.
168: PARAMSTR(0) = C:\TEST.EXE
169: DRIVE + NAME + EXT = C:\TEST.EXE
170: Testing invalid path (..)...Success.
171: Testing invalid path (*)...Success.
172: ----------------------------------------------------------------------
173: Running non-LFN tests
174: ----------------------------------------------------------------------
175: ----------------------------------------------------------------------
176: FINDFIRST/ FINDNEXT
177: ----------------------------------------------------------------------
178: Note: The full path should NOT be displayed.
179: ----------------------------------------------------------------------
180: Verifying value of DOS Error...Success.
181: Trying to find an invalid file ('') with Any Attribute...
182: Verifying value of DOS Error...FAILURE. (Value should be 3 (2): File not found.)
183: Trying to find an invalid file ('') with VolumeID attribute...
184: Verifying value of DOS Error...FAILURE. (Value should be 3 (2): File not found.)
185: Trying to find an invalid file (''zz.dat'') with Any Attribute...
186: Verifying value of DOS Error...Success.
187: Trying to find an invalid file (''zz.dat'') with VolumeID attribute...
188: Verifying value of DOS Error...Success.
189: Trying to find an invalid file (''zz.dat'') with Directory attribute...
190: Verifying value of DOS Error...Success.
191: Looking for TESTDOS.DAT with Any Attribute...Success.
192: Looking for TESTDOS.DAT with Directory Attribute...Success.
193: Checking file stats of TESTDOS.DAT...Success.
194: Looking for TESTDOS.DAT...Success.
195: Checking file stats of TESTDOS.DAT...Success.
196: Resources found (full path should not be displayed):
197: .
198: ..
199: MYDIR
200: TESTFILE
201: Searching using * wildcard (normal files + directories)...Success.
202: Resources found (full path should not be displayed):
203:
204: .
205: ..
206: Searching using ??? wildcard (normal files + all special files)...Success.
207: Resources found (full path should not be displayed):
208: Volume ID:
209: .
210: ..
211: MYDIR
212: CWSDPMI.EXE
213: CWSDPMI.SWP
214: DOSBOX.OUT
215: DOSBOX~1.CON
216: EXITCODE.EXE
217: TBREAK.EXE
218: TBREAK.O
219: TDOS.EXE
220: TDOS.O
221: TDOS2.EXE
222: TDOS2.O
223: TEST.EXE
224: TESTDOS.DAT
225: TESTFILE
226: Searching using *.* wildcard in ROOT (normal files + volume ID)...Success.
227: ----------------------------------------------------------------------
228: FSPLIT
229: ----------------------------------------------------------------------
230: Testing invalid filename...Success.
231: Testing paramstr(0)...Success.
232: Testing paramstr(0)...Success.
233: PARAMSTR(0) = C:\TEST.EXE
234: DRIVE + NAME + EXT = C:\TEST.EXE
235: Testing invalid path (..)...Success.
236: Testing invalid path (*)...Success.
ExitCode=1
Test finished with ExitCode=1
{******************************************}
{ Used to check the DOS unit }
{------------------------------------------}
{ Requirements for this unit can be }
{ found in testdos.htm }
{******************************************}
Program TestDos;
Uses Dos;
{**********************************************************************}
{ Some specific OS verifications : }
{ Mainly for file attributes: }
{ Read-Only }
{ Hidden }
{ System File }
{ only work on Win32, OS/2 and DOS }
{$IFDEF MSDOS}
{$DEFINE EXTATTR}
{$ENDIF}
{$IFDEF DPMI}
{$DEFINE EXTATTR}
{$ENDIF}
{$IFDEF GO32V1}
{$DEFINE EXTATTR}
{$ENDIF}
{$IFDEF GO32V2}
{$DEFINE EXTATTR}
{$ENDIF}
{$IFDEF OS2}
{$DEFINE EXTATTR}
{$ENDIF}
{$IFDEF WIN32}
{$DEFINE EXTATTR}
{$ENDIF}
{$IFDEF ATARI}
{$DEFINE EXTATTR}
{$ENDIF}
{$IFNDEF UNIX}
{$IFDEF LINUX}
{$DEFINE UNIX}
{$ENDIF}
{$IFDEF QNX}
{$DEFINE UNIX}
{$ENDIF}
{$IFDEF SOLARIS}
{$DEFINE UNIX}
{$ENDIF}
{$IFDEF FREEBSD}
{$DEFINE UNIX}
{$ENDIF}
{$IFDEF BEOS}
{$DEFINE UNIX}
{$ENDIF}
{$ENDIF}
{**********************************************************************}
CONST
{ what is the root path }
{$IFDEF EXTATTR}
RootPath = 'C:';
{$ENDIF}
{$IFDEF UNIX}
RootPath = '/';
{$ENDIF}
Week:Array[0..6] of String =
('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
TestFName = 'TESTDOS.DAT'; { CASE SENSITIVE DON'T TOUCH! }
TestFName1 = 'TESTFILE'; { CASE SENSITIVE DON'T TOUCH! }
TestDir = 'MYDIR'; { CASE SENSITIVE DON'T TOUCH! }
TestExt = 'DAT';
has_errors : boolean = false;
Procedure PauseScreen;
var
ch: char;
Begin
{ this is the non-interacting version
so we disable this
WriteLn('-- Press any key --');
ReadLn;}
end;
{ verifies that the DOSError variable is equal to }
{ the value requested. }
Procedure CheckDosError(err: Integer);
var
x : integer;
s :string;
Begin
Write('Verifying value of DOS Error...');
x := DosError;
case x of
0 : s := '(0): No Error.';
2 : s := '(2): File not found.';
3 : s := '(3): Path not found.';
5 : s := '(5): Access Denied.';
6 : s := '(6): Invalid File Handle.';
8 : s := '(8): Not enough memory.';
10 : s := '(10) : Invalid Environment.';
11 : s := '(11) : Invalid format.';
18 : s := '(18) : No more files.';
else
s := 'INVALID DOSERROR';
end;
if err <> x then
Begin
WriteLn('FAILURE. (Value should be ',err,' '+s+')');
has_errors:=true;
end
else
WriteLn('Success.');
end;
Procedure TestSystemDate;
var
Year,Month, DayOfWeek, Day: Word;
Year1,Month1, DayOfWeek1, Day1: Word;
s: string;
Begin
WriteLn('----------------------------------------------------------------------');
WriteLn(' GETDATE ');
WriteLn('----------------------------------------------------------------------');
WriteLn(' Note: Number of week should be consistent (0 = Sunday) ');
WriteLn(' Note: Year should contain full four digits. ');
WriteLn('----------------------------------------------------------------------');
CheckDosError(0);
Month:=0;
Day:=0;
DayOfWeek:=0;
Year:=0;
GetDate(Year,Month,Day,DayOfWeek);
CheckDosError(0);
Write('DD-MM-YYYY : ',Day,'-',Month,'-',Year);
WriteLn(' (',Week[DayOfWeek],')');
PauseScreen;
WriteLn('----------------------------------------------------------------------');
WriteLn(' SETDATE ');
WriteLn('----------------------------------------------------------------------');
{ normal call }
SetDate(Year,Month,Day);
CheckDosError(0);
{ setdate and settime is not supported on most platforms }
{$ifdef go32v2}
s:='Testing with invalid year....';
SetDate(98,Month,Day);
CheckDosError(0);
GetDate(Year1,Month1,Day1,DayOfWeek1);
CheckDosError(0);
if (Year1 <> Year) or (Month1 <> month) or (Day1 <> Day) then
Begin
WriteLn(s+'FAILURE.');
end
else
WriteLn(s+'Success.');
SetDate(Year,Month,255);
CheckDosError(0);
s:='Testing with invalid day.....';
GetDate(Year1,Month1,Day1,DayOfWeek1);
CheckDosError(0);
if (Year1 <> Year) or (Month1 <> month) or (Day1 <> Day) then
Begin
WriteLn(s+'FAILURE.');
end
else
WriteLn(s+'Success.');
SetDate(Year,13,Day);
CheckDosError(0);
s:='Testing with invalid month...';
GetDate(Year1,Month1,Day1,DayOfWeek1);
CheckDosError(0);
if (Year1 <> Year) or (Month1 <> month) or (Day1 <> Day) then
Begin
WriteLn(s+'FAILURE.');
end
else
WriteLn(s+'Success.');
WriteLn('----------------------------------------------------------------------');
WriteLn(' Note: Date should be 01-01-1998 ');
WriteLn('----------------------------------------------------------------------');
SetDate(1998,01,01);
CheckDosError(0);
GetDate(Year1,Month1,Day1,DayOfWeek1);
CheckDosError(0);
WriteLn('DD-MM-YYYY : ',Day1,'-',Month1,'-',Year1);
SetDate(Year,Month,Day);
CheckDosError(0);
WriteLn('----------------------------------------------------------------------');
WriteLn(' Note: Date should be restored to previous value ');
WriteLn('----------------------------------------------------------------------');
GetDate(Year1,Month1,Day1,DayOfWeek1);
CheckDosError(0);
WriteLn('DD-MM-YYYY : ',Day1,'-',Month1,'-',Year1);
PauseScreen;
{$endif}
end;
Procedure TestsystemTime;
Var
Hour, Minute, Second, Sec100: word;
Hour1, Minute1, Second1, Sec1001: word;
Begin
WriteLn('----------------------------------------------------------------------');
WriteLn(' GETTIME ');
WriteLn('----------------------------------------------------------------------');
WriteLn(' Note: Hours should be in military format (0..23), and MSec in 0..100 ');
WriteLn('----------------------------------------------------------------------');
CheckDosError(0);
Hour:=0;
Minute:=0;
Second:=0;
Sec100:=0;
GetTime(Hour,Minute,Second,Sec100);
CheckDosError(0);
WriteLn('HH:MIN:SEC (MS): ',Hour,':',Minute,':',Second,' (',Sec100,')');
WriteLn('----------------------------------------------------------------------');
WriteLn(' SETTIME ');
WriteLn('----------------------------------------------------------------------');
WriteLn(' Note: GetTime should return the same value as the previous test. ');
WriteLn('----------------------------------------------------------------------');
SetTime(36,Minute,Second,Sec100);
CheckDosError(0);
GetTime(Hour1,Minute1,Second1,Sec1001);
CheckDosError(0);
WriteLn('HH:MIN:SEC ',Hour1,':',Minute1,':',Second1);
{ actual settime is only supported under DOS }
{$ifdef go32v2}
SetTime(Hour,32000,Second,Sec100);
CheckDosError(0);
GetTime(Hour1,Minute1,Second1,Sec1001);
CheckDosError(0);
WriteLn('HH:MIN:SEC ',Hour1,':',Minute1,':',Second1);
WriteLn('----------------------------------------------------------------------');
WriteLn(' Note: GetTime should return 0:0:0 ');
WriteLn('----------------------------------------------------------------------');
SetTime(0,0,0,0);
CheckDosError(0);
GetTime(Hour1,Minute1,Second1,Sec1001);
CheckDosError(0);
WriteLn('HH:MIN:SEC ',Hour1,':',Minute1,':',Second1);
WriteLn('----------------------------------------------------------------------');
WriteLn(' Note: GetTime should return approximately the original time ');
WriteLn('----------------------------------------------------------------------');
SetTime(Hour,Minute,Second,Sec1001);
CheckDosError(0);
GetTime(Hour1,Minute1,Second1,Sec1001);
CheckDosError(0);
WriteLn('HH:MIN:SEC ',Hour1,':',Minute1,':',Second1);
{$endif}
end;
Procedure TestFTime;
var
s : string;
F: File;
Time: Longint;
DT: DateTime;
DT1 : Datetime; { saved values }
Begin
WriteLn('----------------------------------------------------------------------');
WriteLn(' GETFTIME / SETFTIME ');
WriteLn('----------------------------------------------------------------------');
CheckDosError(0);
{**********************************************************************}
{********************** TURBO PASCAL BUG ******************************}
{ The File is not Open and DosError is still zero! THIS SHOULD NOT BE }
{ SO IN FPC! }
{**********************************************************************}
{********************** TURBO PASCAL BUG ******************************}
Write('Opening an invalid file...');
Assign(f,'x');
GetFTime(f,Time);
CheckDosError(6);
Write('Trying to open ',TestFName,'...');
Assign(f,TestFName);
Reset(f,1);
GetFTime(f,Time);
CheckDosError(0);
UnpackTime(Time,Dt);
WriteLn('----------------------------------------------------------------------');
WriteLn(' Note: Hour should be in military format and year should be a 4 digit ');
WriteLn(' number. ');
WriteLn('----------------------------------------------------------------------');
WriteLn('DD-MM-YYYY : ',DT.Day,'-',DT.Month,'-',DT.Year);
WriteLn('HH:MIN:SEC ',DT.Hour,':',DT.Min,':',DT.Sec);
{ SETFTIME / GETFTIME No Range checking is performed so the tests are }
{ very limited. }
s:='Setting '+TestFName+' date/time to 01-28-1998:0:0:0...';
dt1.Year:=1998;
dt1.Month:=1;
dt1.Day:=28;
Dt1.Hour:=0;
Dt1.Min:=0;
Dt1.Sec:=0;
PackTime(DT1,Time);
CheckDosError(0);
SetFTime(f,Time);
CheckDosError(0);
GetFTime(f,Time);
CheckDosError(0);
{ Re-initialize the date time file }
FillChar(Dt1,sizeof(dt1),#0);
UnpackTime(Time,Dt1);
if (Dt1.Year <> 1998) or (Dt1.Month<>1) or (Dt1.Day<>28) or
(Dt1.Hour<>0) or (Dt1.Min <>0) or (Dt1.Sec<>0) then
Begin
WriteLn(s+'FAILURE.');
end
else
WriteLn(s+'Success.');
s:='Restoring old file time stamp...';
Move(Dt,Dt1,sizeof(Dt));
PackTime(DT1,Time);
CheckDosError(0);
SetFTime(f,Time);
CheckDosError(0);
GetFTime(f,Time);
CheckDosError(0);
{ Re-initialize the date time file }
FillChar(Dt1,sizeof(dt),#0);
UnpackTime(Time,Dt1);
if (Dt1.Year <> Dt.Year) or (Dt1.Month<>Dt.Month) or (Dt1.Day<>Dt.Day) or
(Dt1.Hour<>Dt.Hour) or (Dt1.Min <> Dt.Min) or (Dt1.Sec<>Dt.Sec) then
Begin
WriteLn(s+'FAILURE.');
end
else
WriteLn(s+'Success.');
Close(f);
end;
Procedure TestFind;
var
Search: SearchRec;
DT: Datetime;
Year, Month, Day, DayOfWeek: Word;
Failure : Boolean;
FoundDot, FoundDotDot: boolean;
FoundDir : boolean;
s : string;
Begin
WriteLn('----------------------------------------------------------------------');
WriteLn(' FINDFIRST/ FINDNEXT ');
WriteLn('----------------------------------------------------------------------');
WriteLn(' Note: The full path should NOT be displayed. ');
WriteLn('----------------------------------------------------------------------');
CheckDosError(0);
WriteLn('Trying to find an invalid file ('''') with Any Attribute...');
FindFirst('',AnyFile,Search);
CheckDosError(3);
{$IFDEF FPC}
FindClose(Search);
{$ENDIF}
{$ifdef go32v2}
WriteLn('Trying to find an invalid file ('''') with VolumeID attribute...');
FindFirst('',VolumeID,Search);
CheckDosError(3);
{$IFDEF FPC}
FindClose(Search);
{$ENDIF}
{$endif go32v2}
WriteLn('Trying to find an invalid file (''''zz.dat'''') with Any Attribute...');
FindFirst('zz.dat',AnyFile,Search);
CheckDosError(18);
{$IFDEF FPC}
FindClose(Search);
{$ENDIF}
WriteLn('Trying to find an invalid file (''''zz.dat'''') with VolumeID attribute...');
FindFirst('zz.dat',VolumeID,Search);
CheckDosError(18);
{$IFDEF FPC}
FindClose(Search);
{$ENDIF}
WriteLn('Trying to find an invalid file (''''zz.dat'''') with Directory attribute...');
FindFirst('zz.dat',Directory,Search);
CheckDosError(18);
{$IFDEF FPC}
FindClose(Search);
{$ENDIF}
s:='Looking for '+TestFName +' with Any Attribute...';
FindFirst('*.DAT',AnyFile,Search);
if Search.Name <> TestFName then
Begin
repeat
FindNext(Search);
until (DosError <> 0) OR (Search.Name = TestFName);
end;
if Search.Name <> TestFName then
{ At least testdos.dat should appear }
WriteLn(s+'FAILURE. ',TestFName,' should be found.')
else
WriteLn(s+'Success.');
{$IFDEF FPC}
FindClose(Search);
{$ENDIF}
{ In addition to normal files }
{ directory files should also be found }
s:='Looking for '+TestFName +' with Directory Attribute...';
FindFirst('*.DAT',Archive+Directory,Search);
if DosError<> 0 then
WriteLn(s+'FAILURE. ',TestFName,' should be found.')
else
WriteLn(s+'Success.');
if Search.Name <> TestFName then
Begin
repeat
FindNext(Search);
until (DosError <> 0) OR (Search.Name = TestFName);
end;
{$IFDEF FPC}
FindClose(Search);
{$ENDIF}
Write('Checking file stats of ',TestFName,'...');
UnpackTime(Search.Time,DT);
GetDate(Year, Month, Day, DayOfWeek);
if (Search.Size <> Sizeof(week)) OR (DT.Year <> Year) OR (DT.Month <> Month)
OR (DT.Day <> Day)
then
Begin
WriteLn('FAILURE. Size/Date is different.')
end
else
WriteLn('Success.');
Write('Looking for ',TestFName,'...');
FindFirst('*.D??',AnyFile,Search);
{ At least testdos.dat should appear }
if DosError <> 0 then
WriteLn('FAILURE. ',Testfname,' should be found.')
else
WriteLn('Success.');
if Search.Name <> TestFName then
Begin
repeat
FindNext(Search);
until (DosError <> 0) OR (Search.Name = TestFName);
end;
{$IFDEF FPC}
FindClose(Search);
{$ENDIF}
Write('Checking file stats of ',TestFName,'...');
UnpackTime(Search.Time,DT);
GetDate(Year, Month, Day, DayOfWeek);
if (Search.Size <> Sizeof(week)) OR (DT.Year <> Year) OR (DT.Month <> Month)
OR (DT.Day <> Day)
then
Begin
WriteLn('FAILURE. Size/Date is different.')
end
else
WriteLn('Success.');
{ Should show all possible files }
FoundDot := False;
FoundDotDot := False;
Failure := True;
FoundDir := False;
s:='Searching using * wildcard (normal files + directories)...';
FindFirst('*',Archive+Directory,Search);
WriteLn(#9'Resources found (full path should not be displayed):');
while DosError = 0 do
Begin
If Search.Name = TestDir then
Begin
If Search.Attr and Directory <> 0 then
FoundDir := TRUE;
end;
If Search.Name = '.' then
Begin
If Search.Attr and Directory <> 0 then
FoundDot := TRUE;
End;
if Search.Name = '..' then
Begin
If Search.Attr and Directory <> 0 then
FoundDotDot := TRUE;
End;
{ check for both . and .. special files }
If Search.Name = TestFName1 then
Failure := FALSE;
WriteLn(#9+Search.Name);
FindNext(Search);
end;
{$IFDEF FPC}
FindClose(Search);
{$ENDIF}
if not FoundDir then
WriteLn(s+'FAILURE. Did not find '+TestDir+' directory')
else
if not FoundDot then
WriteLn(s+'FAILURE. Did not find special ''''.'''' directory')
else
if not FoundDotDot then
WriteLn(s+'FAILURE. Did not find special ''''..'''' directory')
else
if Failure then
WriteLn(s+'FAILURE. Did not find special '+TestFName1+' directory')
else
WriteLn(s+'Success.');
{$IFDEF FPC}
FindClose(Search);
{$ENDIF}
{$ifdef go32v2}
s:='Searching using ??? wildcard (normal files + all special files)...';
FindFirst('???',AnyFile,Search);
FoundDot := False;
FoundDotDot := False;
WriteLn(#9'Resources found (full path should not be displayed):');
while DosError = 0 do
Begin
If Search.Name = '.' then
Begin
If Search.Attr and Directory <> 0 then
FoundDot := TRUE;
End;
if Search.Name = '..' then
Begin
If Search.Attr and Directory <> 0 then
FoundDotDot := TRUE;
End;
WriteLn(#9+Search.Name);
FindNext(Search);
end;
if not FoundDot then
WriteLn(s+'FAILURE. Did not find special ''''.'''' directory')
else
if not FoundDotDot then
WriteLn(s+'FAILURE. Did not find special ''''..'''' directory')
else
WriteLn(s+'Success.');
{$IFDEF FPC}
FindClose(Search);
{$ENDIF}
{ search for volume ID }
s:='Searching using * wildcard in ROOT (normal files + volume ID)...';
FindFirst(RootPath+'*',Directory+VolumeID,Search);
Failure := TRUE;
WriteLn(#9'Resources found (full path should not be displayed):');
while DosError = 0 do
Begin
If Search.Attr and VolumeID <> 0 then
Begin
Failure := FALSE;
WriteLn(#9'Volume ID: '+Search.Name);
End
else
WriteLn(#9+Search.Name);
FindNext(Search);
end;
If Failure then
WriteLn(s+'FAILURE. Did not find volume name')
else
WriteLn(s+'Success.');
{$IFDEF FPC}
FindClose(Search);
{$ENDIF}
{$endif}
end;
Procedure TestSplit;
var
P: PathStr;
D: DirStr;
N: NameStr;
E: ExtStr;
temp : string;
Begin
WriteLn('----------------------------------------------------------------------');
WriteLn(' FSPLIT ');
WriteLn('----------------------------------------------------------------------');
Write('Testing invalid filename...');
{ Initialize names ot invalid values! }
D:='Garbage';
N:='Garbage';
E:='GAR';
{ This is the path to be split }
P:='';
FSPlit(P,D,N,E);
IF (length(D) <> 0) OR (length(N) <>0) OR (length(E) <> 0) THEN
WriteLn('FAILURE. Same length as PATH (now length 0) should be returned.')
else
WriteLn('Success.');
Write('Testing paramstr(0)...');
{ Initialize names ot invalid values! }
D:='Garbage';
N:='Garbage';
E:='GAR';
{ This is the path to be split }
P:=paramstr(0);
FSPlit(P,D,N,E);
IF length(p) <> (length(d)+length(n)+length(e)) then
WriteLn('FAILURE. Same length as PATH should be returned.')
else
WriteLn('Success.');
temp:=d+n+e;
Write('Testing paramstr(0)...');
if temp <> p then
WriteLn('FAILURE. Concatenated string should be the same.')
else
WriteLn('Success.');
WriteLn('PARAMSTR(0) = ', ParamStr(0));
WriteLn('DRIVE + NAME + EXT = ',d+n+e);
{$ifdef go32v2}
Write('Testing invalid path (..)...');
P:='..';
FSPlit(P,D,N,E);
IF (length(D) <> 0) OR (length(N) <>0) OR (E <> P) THEN
WriteLn('FAILURE. Length of drive and name should be zero and Ext should return Path')
else
WriteLn('Success.');
{$endif}
Write('Testing invalid path (*)...');
P:='*';
FSPlit(P,D,N,E);
IF (length(D) <> 0) OR (length(e) <>0) OR (N <> P) THEN
WriteLn('FAILURE. Length of drive and name should be zero and Name should return Path')
else
WriteLn('Success.');
end;
var
F: File;
Attr : Word;
Begin
TestSystemDate;
TestSystemTime;
{ Now the file I/O functions }
{ Let us create a file that we will play with }
Assign(f,TestFName);
Rewrite(f,1);
BlockWrite(f,Week,sizeof(Week));
Close(f);
Assign(f,TestFName1);
Rewrite(f,1);
Close(F);
MkDir(TestDir);
TestFTime;
TestFind;
PauseScreen;
TestSplit;
RmDir(TestDir);
PauseScreen;
{ Cleanup }
{$I-}
assign(f,TestFName);
erase(f);
assign(f,TestFName1);
erase(f);
{$I+}
if ioresult<>0 then;
if has_errors then
halt(1);
end.
{
$Log: tdos2.pp,v $
Revision 1.12 2002/12/06 16:38:15 peter
* cleanup tempfiles
Revision 1.11 2002/12/06 16:36:17 peter
* made more tests go32v2 specific because they expect (buggy?) Dos
findfirst behaviour
Revision 1.10 2002/11/27 16:41:46 peter
* volumeid is dos specific
Revision 1.9 2002/11/18 09:49:49 pierre
* tried to make as many as possible tests non interactive
Revision 1.8 2002/11/08 21:01:18 carl
* separated some tests
* make tfexpand more portable
Revision 1.7 2002/09/07 15:40:56 peter
* old logs removed and tabs fixed
}