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

* add test for web bug #16651

Browse Source 
git-svn-id: trunk@15456 -
This commit is contained in:
Tomas Hajny 2010-06-19 16:27:03 +00:00
parent d6d411442b
commit 7d5b63042b
1 changed files with 28 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
tests/test/units/dos/tfexpand.pp
View File

@ -100,6 +100,7 @@ const
{$ELSE MACOS} {$ELSE MACOS}
{$IFDEF UNIX} {$IFDEF UNIX}
DirectorySeparator = '/'; DirectorySeparator = '/';
DriveSeparator = '/';
FileNameCaseSensitive = true; FileNameCaseSensitive = true;
{$ELSE UNIX} {$ELSE UNIX}
{$IFDEF AMIGA} {$IFDEF AMIGA}
@ -150,12 +151,14 @@ begin
for I := 1 to Length (S) do for I := 1 to Length (S) do
if S [I] = DirectorySeparator2 then if S [I] = DirectorySeparator2 then
S [I] := DirectorySeparator; S [I] := DirectorySeparator;
{$IFNDEF FPC_FEXPAND_DRIVES}
if DriveSeparator = DirectorySeparator then if DriveSeparator = DirectorySeparator then
begin I := Pos (DirectorySeparator + DirectorySeparator, S)
I := Pos (DirectorySeparator + DirectorySeparator, S); else
if I <> 0 then I := Pos (DriveSeparator, S);
Delete (S, I, 1); if I <> 0 then
end; Delete (S, 1, I);
{$ENDIF FPC_FEXPAND_DRIVES}
end; end;
procedure GetDir (Drive: byte; var Directory: string); procedure GetDir (Drive: byte; var Directory: string);
@ -202,6 +205,13 @@ begin
{$ENDIF DEBUG} {$ENDIF DEBUG}
Rslt := Translate (Rslt); Rslt := Translate (Rslt);
Rslt2 := FExpand (Src); Rslt2 := FExpand (Src);
{$IFDEF DIRECT}
{$IFNDEF FPC_FEXPAND_DRIVES}
I := Pos (System.DriveSeparator, Rslt2);
if I <> 0 then
Delete (Rslt2, 1, I);
{$ENDIF FPC_FEXPAND_DRIVES}
{$ENDIF DIRECT}
{$IFNDEF UNIX} {$IFNDEF UNIX}
if (Length (Rslt2) > 1) and (Rslt2 [1] in ['a'..'z']) and (Rslt2[2]=DriveSep) then if (Length (Rslt2) > 1) and (Rslt2 [1] in ['a'..'z']) and (Rslt2[2]=DriveSep) then
Rslt2 [1] := UpCase (Rslt2 [1]); Rslt2 [1] := UpCase (Rslt2 [1]);
@ -253,6 +263,11 @@ begin
TestDir0 := TestDir; TestDir0 := TestDir;
{$IFDEF DIRECT} {$IFDEF DIRECT}
XToDirect (TestDir); XToDirect (TestDir);
{$IFNDEF FPC_FEXPAND_DRIVES}
I := Pos (System.DriveSeparator, TestDir);
if I <> 0 then
Delete (TestDir, 1, I);
{$ENDIF FPC_FEXPAND_DRIVES}
{$ENDIF DIRECT} {$ENDIF DIRECT}
Assign (F, TestFileName); Assign (F, TestFileName);
Rewrite (F); Rewrite (F);
@ -263,6 +278,13 @@ begin
{$ENDIF DIRECT} {$ENDIF DIRECT}
{$I+} {$I+}
GetDir (0, CurDir); GetDir (0, CurDir);
{$IFDEF DIRECT}
{$IFNDEF FPC_FEXPAND_DRIVES}
I := Pos (System.DriveSeparator, CurDir);
if I <> 0 then
Delete (CurDir, 1, I);
{$ENDIF FPC_FEXPAND_DRIVES}
{$ENDIF DIRECT}
{$IFNDEF NODRIVEC} {$IFNDEF NODRIVEC}
GetDir (3, CDir); GetDir (3, CDir);
{$ENDIF NODRIVEC} {$ENDIF NODRIVEC}
@ -326,6 +348,7 @@ if CDir [Length (CDir)] = DirSep then Check ('c:anything', CDir + 'anything')
Check ('.' + DirSep + 'd', CurDir + DirSep + 'd'); Check ('.' + DirSep + 'd', CurDir + DirSep + 'd');
{$ENDIF NODOTS} {$ENDIF NODOTS}
{$ENDIF MACOS} {$ENDIF MACOS}
Check ('d' + DirSep + TestFileName, CurDir + DirSep + 'd' + DirSep + TestFileName);
Check (' d', CurDir + DirSep + ' d'); Check (' d', CurDir + DirSep + ' d');
Check ('dd', CurDir + DirSep + 'dd'); Check ('dd', CurDir + DirSep + 'dd');
{$IFDEF MACOS} {$IFDEF MACOS}