From 464f3998f1f88fedea4c3c05db72d9c212570f33 Mon Sep 17 00:00:00 2001 From: carl Date: Mon, 2 Apr 2001 02:34:13 +0000 Subject: [PATCH] + initial version of complete test for dos unit --- tests/test/units/dos/testdos.pas | 984 +++++++++++++++++++++++++++++++ 1 file changed, 984 insertions(+) create mode 100644 tests/test/units/dos/testdos.pas diff --git a/tests/test/units/dos/testdos.pas b/tests/test/units/dos/testdos.pas new file mode 100644 index 0000000000..40971b1244 --- /dev/null +++ b/tests/test/units/dos/testdos.pas @@ -0,0 +1,984 @@ +{ %INTERACTIVE } +{******************************************} +{ Used to check the DOS unit } +{------------------------------------------} +{ Requirements for this unit can be } +{ found in testdos.htm } +{******************************************} +Program TestDos; + +Uses Dos; + +{----------------------------------------------------------------------} +{ The following routines are not portable, and therefore have not been } +{ added in this test unit: } +{----------------------------------------------------------------------} +{ o GetIntVec } +{ o SetIntVec } +{ o Intr } +{ o Keep } +{ o MSDOS } +{ o Swapvectors (can't really be tested) } +{----------------------------------------------------------------------} +{ ROUTINES LEFT TO DO: +DosExitCode | Func | Returns the exit code of a subprocess. +Exec | Proc | Executes a specified program with a specified command + | | line. +FExpand | Func | Expands a file name into a fully-qualified file name. +FSearch | Func | Searches for a file. +GetEnv | Func | Returns the value of a specified environment variable. +} +{**********************************************************************} +{ 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 OS2} + {$DEFINE EXTATTR} +{$ENDIF} +{$IFDEF WIN32} + {$DEFINE EXTATTR} +{$ENDIF} +{$IFDEF TOS} + {$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} +{$ENDIF} +const +{ what is the root path } +{$IFDEF EXTATTR} + RootPath = 'C:\'; +{$ENDIF} +{$IFDEF UNIX} + RootPath := '/'; +{$ENDIF} +{**********************************************************************} + + + +CONST + 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'; + + +Procedure PauseScreen; +var + ch: char; +Begin + 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+')'); + end + else + WriteLn('Success.'); + end; + + +Procedure TestdiskSize; +Var + i : Integer; +Begin + WriteLn('----------------------------------------------------------------------'); + WriteLn(' DISKSIZE/DISKFREE '); + WriteLn('----------------------------------------------------------------------'); + WriteLn(' Note: Should return -1 on both functions if device is not ready. '); + WriteLn('----------------------------------------------------------------------'); + CheckDosError(0); +{ Check Disksize / DiskFree routines } + for I:=0 to 20 do + Begin + Write('Disk unit ',i:2,' free size : ',DiskFree(i):10, ' Total Size: ',DiskSize(i):10); + WriteLn(' bytes.'); + end; + CheckDosError(0); + PauseScreen; +end; + +Procedure TestDosVersion; +Begin + WriteLn('----------------------------------------------------------------------'); + WriteLn(' DOSVERSION '); + WriteLn('----------------------------------------------------------------------'); + WriteLn(' Note: Number should be major version followed by minor version. '); + WriteLn('----------------------------------------------------------------------'); + CheckDosError(0); + {*------------------------- NOTE -------------------------------------*} + {* This is OS specific. LO -> Major revision, HI -> Minor Revision *} + {*--------------------------------------------------------------------*} + WriteLn('Operating system Version :',Lo(DosVersion),'.',Hi(DosVersion)); + CheckDosError(0); + PauseScreen; +end; + +Procedure TestEnvCount; +Var + I: Integer; +Begin + WriteLn('----------------------------------------------------------------------'); + WriteLn(' ENVCOUNT/ENVSTR '); + WriteLn('----------------------------------------------------------------------'); + WriteLn(' Note: Environment variables should be of the form VAR=VALUE '); + WriteLn(' Note: Non valid indexes should return empty strings. '); + WriteLn(' Note: Index 0 points to an empty string '); + WriteLn('----------------------------------------------------------------------'); + CheckDosError(0); + PauseScreen; + {*------------------------- NOTE -------------------------------------*} + {* Variables should be of the form VAR=VALUE *} + {*--------------------------------------------------------------------*} + WriteLn('CURRENT ENVIRONMENT'); + For I:=1 to EnvCount do + WriteLn(EnvStr(i)); + CheckDosError(0); + WriteLn('----------------------------------------------------------------------'); + WriteLn(' Note: The next few lines should be empty strings, as they are '); + WriteLn(' invalid environment indexes. '); + WriteLn('----------------------------------------------------------------------'); + For i:=-5 to 0 do + WriteLn(EnvStr(i)); + CheckDosError(0); + For i:=20000 to 20002 do + WriteLn(EnvStr(i)); + CheckDosError(0); + PauseScreen; +end; + +Procedure TestVerify; +Var + B: Boolean; + s: string; +Begin + WriteLn('----------------------------------------------------------------------'); + WriteLn(' GETVERIFY/SETVERIFY '); + WriteLn('----------------------------------------------------------------------'); + CheckDosError(0); + s:='Testing GetVerify...'; + SetVerify(TRUE); + CheckDosError(0); + GetVerify(b); + CheckDosError(0); + if b then + WriteLn(s+'Success.') + else + Begin + WriteLn(s+'FAILURE.'); +{ Halt;} + end; + s:='Testing GetVerify...'; + SetVerify(FALSE); + CheckDosError(0); + GetVerify(b); + CheckDosError(0); + if NOT b then + WriteLn(s+'Success.') + else + Begin + WriteLn(s+'FAILURE.'); + end; + PauseScreen; +end; + +Procedure TestCBreak; +Var + B: Boolean; + s: string; +Begin + WriteLn('----------------------------------------------------------------------'); + WriteLn(' GETCBREAK/SETCBREAK '); + WriteLn('----------------------------------------------------------------------'); + CheckDosError(0); + s:='Testing GetCBreak...'; + SetCBreak(TRUE); + CheckDosError(0); + GetCBreak(b); + CheckDosError(0); + if b then + WriteLn(s+'Success.') + else + Begin + WriteLn(s+'FAILURE.'); + end; + s:='Testing GetCBreak...'; + SetCBreak(FALSE); + CheckDosError(0); + GetCBreak(b); + CheckDosError(0); + if NOT b then + WriteLn(s+'Success.') + else + Begin + WriteLn(s+'FAILURE.'); + end; + PauseScreen; +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('----------------------------------------------------------------------'); +{ WriteLn(' Note: GetDate should return the same value as previous test. '); + WriteLn('----------------------------------------------------------------------');} + { We'll change each field to an invalid field separately } + s:='Testing with invalid year....'; + SetDate(2200,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.'); + + 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; +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); + 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); +end; + + +Procedure TestFAttr; +Var + F: File; + Attr: Word; + s: string; +Begin + PauseScreen; + WriteLn('----------------------------------------------------------------------'); + WriteLn(' GETFATTR / SETFATTR '); + WriteLn('----------------------------------------------------------------------'); + CheckDosError(0); + + WriteLn('Opening an invalid file...Success.'); + Assign(f,''); + GetFAttr(f,Attr); + CheckDosError(3); + Assign(f,TestFName); + WriteLn('Trying to open a valid file..Success.'); + GetFAttr(f,Attr); + CheckDosError(0); + {----------------------------------------------------------------} + { This routine causes problems, because it all depends on the } + { operating system. It is assumed here that HIDDEN is available } + { to all operating systems. } + {----------------------------------------------------------------} + s:='Setting read-only attribute on '+TestFName+'...'; + SetFAttr(f,ReadOnly); + CheckDosError(0); +{$IFDEF EXTATTR} + GetFAttr(f,Attr); + CheckDosError(0); + if Attr and ReadOnly<> 0 then + WriteLn(s+'Success.') + else + Begin + WriteLn(s+'FAILURE. Read-only attribute not set.'); + end; + { file should no longer be read only } + s:='Removing read-only attribute...'; + SetFAttr(f,Archive); + CheckDosError(0); + GetFAttr(f,Attr); + CheckDosError(0); + if Attr and ReadOnly<> 0 then + Begin + WriteLn(s+'FAILURE. Read-only attribute still set.'); + end + else + WriteLn(s+'Success.'); +{$ENDIF} + + s:='Setting hidden attribute on '+TestFName+'...'; + SetFAttr(f,Hidden); + CheckDosError(0); +{$IFDEF EXTATTR} + GetFAttr(f,Attr); + CheckDosError(0); + if Attr and Hidden<> 0 then + WriteLn(s+'Success.') + else + Begin + WriteLn(s+'FAILURE. Hidden attribute not set.'); + end; + + { file should no longer be read only } + s:='Removing hidden attribute...'; + SetFAttr(f,Archive); + CheckDosError(0); + GetFAttr(f,Attr); + CheckDosError(0); + if Attr and Hidden<> 0 then + Begin + WriteLn(s+'FAILURE. Hidden attribute still set.'); + end + else + WriteLn(s+'Success.'); +{$ENDIF} + + s:='Setting system attribute on '+TestFName+'...'; + SetFAttr(f,SysFile); + CheckDosError(0); +{$IFDEF EXTATTR} + GetFAttr(f,Attr); + CheckDosError(0); + if Attr and SysFile<> 0 then + WriteLn(s+'Success.') + else + Begin + WriteLn(s+'FAILURE. SysFile attribute not set.'); + end; + { file should no longer be read only } + s:='Removing read-only attribute...'; + SetFAttr(f,Archive); + CheckDosError(0); + GetFAttr(f,Attr); + CheckDosError(0); + if Attr and Sysfile<> 0 then + Begin + WriteLn(s+'FAILURE. SysFile attribute still set.'); + end + else + WriteLn(s+'Success.'); +{$ENDIF} + + s:='Setting Directory attribute on '+TestFName+'...'; + SetFAttr(f,Directory); + CheckDosError(5); + GetFAttr(f,Attr); + CheckDosError(0); + if Attr and Directory<> 0 then + Begin + WriteLn(s+'FAILURE. Directory Attribute set.'); + end + else + WriteLn(s+'Success.'); + + {**********************************************************************} + {********************** TURBO PASCAL BUG ******************************} + { The File is not a volume name, and DosError = 0, which is incorrect } + { it shoulf not be so in FPC. } + {**********************************************************************} + {********************** TURBO PASCAL BUG ******************************} + s:='Setting Volume attribute on '+TestFName+'...'; + SetFAttr(f,VolumeID); + CheckDosError(5); + GetFAttr(f,Attr); + CheckDosError(0); + if Attr and VolumeID<> 0 then + Begin + WriteLn(s+'FAILURE. Volume Attribute set.'); + end + else + WriteLn(s+'Success.'); + + PauseScreen; +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} + + WriteLn('Trying to find an invalid file ('''') with VolumeID attribute...'); + FindFirst('',VolumeID,Search); + CheckDosError(3); +{$IFDEF FPC} + FindClose(Search); +{$ENDIF} + + 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); + { At least testdos.dat should appear } + 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} + + { In addition to normal files } + { directory files should also be found } + s:='Looking for '+TestFName +' with Directory Attribute...'; + FindFirst('*.DAT',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('*',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} + + 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+'*',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+Search.Name); + End; + FindNext(Search); + end; + If Failure then + WriteLn(s+'FAILURE. Did not find volume name') + else + WriteLn(s+'Success.'); +{$IFDEF FPC} + FindClose(Search); +{$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); + + 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.'); + 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 +{ ClrScr;} + { TestdiskSize; } + TestDosVersion; + TestEnvCount; + TestVerify; + 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); + TestFAttr; + TestFTime; + TestCBreak; + TestFind; + PauseScreen; + TestSplit; + RmDir(TestDir); + PauseScreen; +end. + +{ +DosExitCode | Func | Returns the exit code of a subprocess. +Exec | Proc | Executes a specified program with a specified command + | | line. +FExpand | Func | Expands a file name into a fully-qualified file name. +FSearch | Func | Searches for a file. +GetEnv | Func | Returns the value of a specified environment variable. +} + +{ + $Log$ + Revision 1.1 2001-04-02 02:34:13 carl + + initial version of complete test for dos unit + + +} \ No newline at end of file