fpc/api/test/testfsys.pas
2000-07-01 23:03:18 +00:00

136 lines
3.0 KiB
ObjectPascal

{ test application for FileSys
make sure a file called testfile.txt (here in FName) exists;
it will be deleted ! }
program TestFS;
uses
ApiComm,
Filesys;
const
Passes = 12;
FName : string[30] = 'testfile.txt';
DName : string[30] = 'test';
TestNames : array[0..Passes-1] of string[30] =
('CreateDir',
'RenameDir',
'ExpandName',
'GetCurrentDir',
'DeleteDir',
'Check name',
'Set time',
'DateToString/TimeToString',
'Set attribute',
'FileAttrToString',
'FileIntToString',
'SplitName'
);
var
i : byte;
n, p, rn, e : TFileName;
dt : TDateTime;
attr : TFileAttr;
fi : TFileInt;
begin
WriteLn ('TestFS - tests capabilities of unit FileSys');
WriteLn ('---');
i := 0;
repeat
{ show topic }
case i of
0 : WriteLn ('<DIRECTORY>');
5 : WriteLn ('<FILE>');
end;
{ show name of action }
Write (TestNames[i], ' ');
{ perform action }
case i of
0 :
begin
Write ('"', DName, '"');
FileSys.CreateDir (DName);
end;
1 :
begin
Write (DName, '=> test2');
RenameDir (DName, 'test2');
GetErrorCode;
RenameDir ('test2', DName);
end;
2 :
begin
Write ('"', ExpandName (DName),'"');
end;
3 :
begin
Write ('"', GetCurrentDir, '"');
end;
4 :
begin
Write ('"', DName, '"');
FileSys.DeleteDir (DName);
end;
{ FILE }
5 :
begin
Write ('"', FName, '" : ');
if (FileSys.CheckName (FName) = cnUnknown)
then Write ('unknown')
else Write ('known');
end;
6 :
begin
Write (' 22 Jul 1997 12:34:56');
with dt do begin
Day := 22;
Month := 7;
Year := 1997;
Hour := 12;
Minute := 34;
Second := 56;
CheckDateTime (dt);
end;
SetFTime (FName, dt);
end;
7 :
begin
Write (DateToString (dt), ' ', TimeToString (dt));
end;
8 :
begin
attr := 128;
SetFAttr (FName, attr);
end;
9 :
begin
Write (FileAttrToString (attr));
end;
10 :
begin
fi := 12345678;
Write (FileIntToString (fi));
end;
11 :
begin
{$ifdef linux}
n := '/sub1/sub3.ext.ext/name.gz';
{$ELSE}
n := 'c:\sub1\sub3.ext.ext\name.gz';
{$endif}
SplitName (n, p, rn, e);
Write ('"', n, '" => ',
'PATH = "', p, '", RAW NAME = "', rn,
'", EXTENSION = "', e, '"');
end;
end;
if (ApiComm.GetErrorCode = errOK)
then WriteLn (' <NO ERROR>')
else WriteLn (' <ERROR>');
inc (i);
until (i = Passes);
WriteLn ('---');
end.