mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 04:09:30 +02:00
+ initial version
This commit is contained in:
Tomas Hajny
parent
3ea7b5d221
commit
114fa8be37
191
tests/test/tfexpand.pas
Normal file
191
tests/test/tfexpand.pas
Normal file
@ -0,0 +1,191 @@
|
||||
program Tst_FExp;
|
||||
|
||||
(* Test for possible bugs in Dos.FExpand *)
|
||||
|
||||
{ $DEFINE DEBUG}
|
||||
(* Defining DEBUG causes all the source and target strings *)
|
||||
(* to be written to the console to make debugging easier. *)
|
||||
|
||||
uses
|
||||
Dos;
|
||||
|
||||
{$IFDEF LINUX}
|
||||
{$IFNDEF UNIX}
|
||||
{$DEFINE UNIX}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
const
|
||||
{$IFNDEF FPC}
|
||||
FileNameCaseSensitive = false;
|
||||
{$ENDIF}
|
||||
{$IFDEF UNIX}
|
||||
DirSep = '/';
|
||||
CDrive = '';
|
||||
{$ELSE}
|
||||
DirSep = '\';
|
||||
CDrive = 'C:';
|
||||
{$ENDIF}
|
||||
HasErrors: boolean = false;
|
||||
|
||||
var
|
||||
TestDir, OrigDir, OrigTstDir, CurDir, CDir, S: DirStr;
|
||||
TestDrive: string [2];
|
||||
I: byte;
|
||||
IOR: longint;
|
||||
|
||||
function Translate (S: PathStr): PathStr;
|
||||
var
|
||||
I: byte;
|
||||
begin
|
||||
{$IFDEF UNIX}
|
||||
if (Length (S) > 1) and (S [2] = ':') then Delete (S, 1, 2);
|
||||
{$ELSE}
|
||||
for I := 1 to Length (S) do if S [I] = '/' then S [I] := DirSep;
|
||||
if (Length (S) > 0) and (S [1] in ['a'..'z']) then S [1] := UpCase (S [1]);
|
||||
{$ENDIF}
|
||||
if not (FileNameCaseSensitive) then
|
||||
for I := 1 to Length (S) do S [I] := UpCase (S [I]);
|
||||
Translate := S;
|
||||
end;
|
||||
|
||||
procedure Check (Src, Rslt: PathStr);
|
||||
var
|
||||
Rslt2: PathStr;
|
||||
begin
|
||||
{$IFDEF DEBUG}
|
||||
WriteLn (Src, '=>', Rslt);
|
||||
{$ENDIF}
|
||||
Rslt := Translate (Rslt);
|
||||
Rslt2 := FExpand (Src);
|
||||
if Rslt <> Rslt2 then
|
||||
begin
|
||||
WriteLn ('Error: FExpand (', Src, ') should be "', Rslt, '", not "',
|
||||
Rslt2, '"');
|
||||
HasErrors := true;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
if ParamCount <> 1 then
|
||||
begin
|
||||
WriteLn ('Warning: Parameter missing!');
|
||||
WriteLn ('Full path to a directory with write access' +
|
||||
{$IFNDEF UNIX}
|
||||
#13#10'(preferably not on a C: drive)' +
|
||||
{$ENDIF}
|
||||
' expected.');
|
||||
WriteLn ('Trying to use the current directory instead (not quite ideal).');
|
||||
GetDir (0, TestDir);
|
||||
end else TestDir := ParamStr (1);
|
||||
if TestDir [Length (TestDir)] <> DirSep then TestDir := TestDir + DirSep;
|
||||
GetDir (0, OrigDir);
|
||||
{$IFDEF UNIX}
|
||||
CDir := CurDir;
|
||||
TestDrive := '';
|
||||
{$ELSE}
|
||||
GetDir (3, CDir);
|
||||
TestDrive := Copy (TestDir, 1, 2);
|
||||
GetDir ((Ord (TestDir [1]) and not ($20)) - 64, OrigTstDir);
|
||||
{$ENDIF}
|
||||
{$I-}
|
||||
MkDir (TestDir + 'TESTDIR1');
|
||||
if IOResult <> 0 then ;
|
||||
MkDir (TestDir + 'TESTDIR1' + DirSep + 'TESTDIR2');
|
||||
if IOResult <> 0 then ;
|
||||
{$I+}
|
||||
ChDir (TestDir + 'TESTDIR1' + DirSep + 'TESTDIR2');
|
||||
GetDir (0, CurDir);
|
||||
Check (' ', CurDir + DirSep + ' ');
|
||||
Check ('', CurDir + DirSep);
|
||||
Check ('.', CurDir);
|
||||
Check ('C:', CDir);
|
||||
Check ('C:.', CDir);
|
||||
if CDir [Length (CDir)] = DirSep then Check ('c:anything', CDir + 'anything')
|
||||
else Check ('c:anything', CDir + DirSep + 'anything');
|
||||
Check ('C:' + DirSep, CDrive + DirSep);
|
||||
Check ('C:' + DirSep + '.', CDrive + DirSep);
|
||||
Check ('C:' + DirSep + '..', CDrive + DirSep);
|
||||
Check ('C:' + DirSep + 'DOS', CDrive + DirSep + 'DOS');
|
||||
Check ('C:' + DirSep + '..' + DirSep + 'DOS', CDrive + DirSep + 'DOS');
|
||||
Check ('C:' + DirSep + 'DOS.', CDrive + DirSep + 'DOS.');
|
||||
Check ('C:' + DirSep + 'DOS' + DirSep, CDrive + DirSep + 'DOS' + DirSep);
|
||||
Check ('C:' + DirSep + 'DOS' + DirSep + '.', CDrive + DirSep + 'DOS');
|
||||
Check ('C:' + DirSep + 'DOS' + DirSep + '..', CDrive + DirSep);
|
||||
Check ('C:' + DirSep + 'DOS' + DirSep + '..' + DirSep, CDrive + DirSep);
|
||||
Check ('C:' + DirSep + 'DOS' + DirSep + 'TEST' + DirSep + '..', CDrive +
|
||||
DirSep + 'DOS');
|
||||
Check ('C:' + DirSep + 'DOS' + DirSep + 'TEST' + DirSep + '..' + DirSep,
|
||||
CDrive + DirSep + 'DOS' + DirSep);
|
||||
Check (DirSep, TestDrive + DirSep);
|
||||
Check (DirSep + '.', TestDrive + DirSep);
|
||||
Check (DirSep + '..', TestDrive + DirSep);
|
||||
Check (DirSep + 'DOS', TestDrive + DirSep + 'DOS');
|
||||
Check ('d', CurDir + DirSep + 'd');
|
||||
Check (' d', CurDir + DirSep + ' d');
|
||||
Check ('dd', CurDir + DirSep + 'dd');
|
||||
Check ('dd' + DirSep + 'dd', CurDir + DirSep + 'dd' + DirSep + 'dd');
|
||||
Check ('ddd', CurDir + DirSep + 'ddd');
|
||||
Check ('dddd' + DirSep + 'eeee.ffff', CurDir + DirSep + 'dddd' + DirSep
|
||||
+ 'eeee.ffff');
|
||||
Check ('.special', CurDir + DirSep + '.special');
|
||||
Check ('..special', CurDir + DirSep + '..special');
|
||||
Check ('special..', CurDir + DirSep + 'special..');
|
||||
Check ('special.' + DirSep, CurDir + DirSep + 'special.' + DirSep);
|
||||
Check (DirSep + '.special', TestDrive + DirSep + '.special');
|
||||
Check ('..', TestDir + 'TESTDIR1');
|
||||
Check ('.' + DirSep + '..', TestDir + 'TESTDIR1');
|
||||
Check ('..' + DirSep + '.', TestDir + 'TESTDIR1');
|
||||
Check ('...', CurDir + DirSep + '...');
|
||||
{$IFDEF UNIX}
|
||||
S := GetEnv ('HOME');
|
||||
Check ('~', S);
|
||||
if (Length (S) > 0) and (S [Length (S)] <> DirSep) then S := S + DirSep;
|
||||
Check ('~NobodyWithThisNameShouldEverExist.test/nothing', '~NobodyWithThisNameShouldEverExist.test/nothing');
|
||||
Check ('~' + DirSep, S);
|
||||
Check ('~' + DirSep + '.', S + '.');
|
||||
Check ('~' + DirSep + 'directory' + DirSep + 'another',
|
||||
S + 'directory' + DirSep + 'another');
|
||||
{$ELSE UNIX}
|
||||
Check (TestDrive + '..', TestDir + 'TESTDIR1');
|
||||
Check (TestDrive + '..' + DirSep, TestDir + 'TESTDIR1' + DirSep);
|
||||
Check (TestDrive + '.' + DirSep + '.', CurDir);
|
||||
Check (TestDrive + '.' + DirSep + '..', TestDir + 'TESTDIR1');
|
||||
{$I-}
|
||||
I := 1;
|
||||
repeat
|
||||
S := '';
|
||||
GetDir (I, S);
|
||||
IOR := IOResult;
|
||||
if IOR = 0 then Inc (I);
|
||||
until (I > 26) or (IOR <> 0);
|
||||
if I <= 26 then
|
||||
begin
|
||||
S := Chr (I + 64) + ':ddd';
|
||||
Check (S, Chr (I + 64) + ':' + DirSep + 'ddd');
|
||||
end else
|
||||
WriteLn ('Sorry, cannot test FExpand behaviour for incorrect drives here.');
|
||||
{$I+}
|
||||
{$IFDEF FPC}
|
||||
Check ('d\d/d', CurDir + DirSep + 'd' + DirSep + 'd' + DirSep + 'd');
|
||||
Check ('\\server\share\directory', '\\server\share\directory');
|
||||
Check ('\\server\share\directory1\directory2\..',
|
||||
'\\server\share\directory1');
|
||||
Check ('\\.', '\\');
|
||||
Check ('\\.\', '\\');
|
||||
Check ('\\.\.', '\\');
|
||||
Check ('\\.\TEST', '\\TEST');
|
||||
Check ('\\..\', '\\');
|
||||
Check ('\\..\TEST', '\\TEST');
|
||||
{$ENDIF FPC}
|
||||
ChDir (OrigTstDir);
|
||||
{$ENDIF UNIX}
|
||||
ChDir (OrigDir);
|
||||
RmDir (TestDir + 'TESTDIR1' + DirSep + 'TESTDIR2');
|
||||
RmDir (TestDir + 'TESTDIR1');
|
||||
if HasErrors then
|
||||
begin
|
||||
WriteLn ('FExpand doesn''t work correctly.');
|
||||
Halt (1);
|
||||
end;
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user