paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 17:49:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

* several updates and more error checking

Browse Source
This commit is contained in:
carl 2001-08-09 01:14:57 +00:00
parent 1479205e69
commit f338edffa4
1 changed files with 26 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
tests/test/units/dos/tdos2.pp
View File

@ -41,6 +41,9 @@ GetEnv | Func | Returns the value of a specified environment variable.
{$IFDEF MSDOS} {$IFDEF MSDOS}
{$DEFINE EXTATTR} {$DEFINE EXTATTR}
{$ENDIF} {$ENDIF}
{$IFDEF DPMI}
{$DEFINE EXTATTR}
{$ENDIF}
{$IFDEF GO32V1} {$IFDEF GO32V1}
{$DEFINE EXTATTR} {$DEFINE EXTATTR}
{$ENDIF} {$ENDIF}
@ -72,20 +75,22 @@ GetEnv | Func | Returns the value of a specified environment variable.
{$IFDEF FREEBSD} {$IFDEF FREEBSD}
{$DEFINE UNIX} {$DEFINE UNIX}
{$ENDIF} {$ENDIF}
{$IFDEF BEOS}
{$DEFINE UNIX}
{$ENDIF} {$ENDIF}
const
{ what is the root path }
{$IFDEF EXTATTR}
RootPath = 'C:\';
{$ENDIF}
{$IFDEF UNIX}
RootPath := '/';
{$ENDIF} {$ENDIF}
{**********************************************************************} {**********************************************************************}
CONST CONST
{ what is the root path }
{$IFDEF EXTATTR}
RootPath = 'C:\';
{$ENDIF}
{$IFDEF UNIX}
RootPath = '/';
{$ENDIF}
Week:Array[0..6] of String = Week:Array[0..6] of String =
('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday'); ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
@ -695,17 +700,18 @@ Begin
s:='Looking for '+TestFName +' with Any Attribute...'; s:='Looking for '+TestFName +' with Any Attribute...';
FindFirst('*.DAT',AnyFile,Search); 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 if Search.Name <> TestFName then
Begin Begin
repeat repeat
FindNext(Search); FindNext(Search);
until (DosError <> 0) OR (Search.Name = TestFName); until (DosError <> 0) OR (Search.Name = TestFName);
end; 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} {$IFDEF FPC}
FindClose(Search); FindClose(Search);
{$ENDIF} {$ENDIF}
@ -851,10 +857,9 @@ Begin
{$IFDEF FPC} {$IFDEF FPC}
FindClose(Search); FindClose(Search);
{$ENDIF} {$ENDIF}
{ search for volume ID } { search for volume ID }
s:='Searching using * wildcard in ROOT (normal files + volume ID)...'; s:='Searching using * wildcard in ROOT (normal files + volume ID)...';
FindFirst(RootPath+'*',VolumeID,Search); FindFirst(RootPath+'*',Directory+VolumeID,Search);
Failure := TRUE; Failure := TRUE;
WriteLn(#9'Resources found (full path should not be displayed):'); WriteLn(#9'Resources found (full path should not be displayed):');
while DosError = 0 do while DosError = 0 do
@ -862,8 +867,10 @@ Begin
If Search.Attr and VolumeID <> 0 then If Search.Attr and VolumeID <> 0 then
Begin Begin
Failure := FALSE; Failure := FALSE;
WriteLn(#9'Volume ID: '+Search.Name);
End
else
WriteLn(#9+Search.Name); WriteLn(#9+Search.Name);
End;
FindNext(Search); FindNext(Search);
end; end;
If Failure then If Failure then
@ -984,7 +991,10 @@ GetEnv | Func | Returns the value of a specified environment variable.
{ {
$Log$ $Log$
Revision 1.3 2001-06-06 01:31:24 carl Revision 1.4 2001-08-09 01:14:57 carl
* several updates and more error checking
Revision 1.3 2001/06/06 01:31:24 carl
* fsplit with .. only works for go32v2 version and TP * fsplit with .. only works for go32v2 version and TP
Revision 1.2 2001/05/20 18:30:46 hajny Revision 1.2 2001/05/20 18:30:46 hajny