paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-07 15:29:35 +01:00
Code Issues Packages Projects Releases Wiki Activity

* FExpand / ExpandFileName behaviour updated according to discussion in bug #34166

Browse Source 
git-svn-id: trunk@39840 -
This commit is contained in:
Tomas Hajny 2018-09-28 22:57:57 +00:00
parent 401064abdc
commit 62b57e81cd
2 changed files with 28 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
rtl/inc/fexpand.inc
View File

@ -443,6 +443,23 @@ begin
{Get string of directories to only process relative references on this one} {Get string of directories to only process relative references on this one}
Dirs := Copy (Pa, Succ (PathStart), Length (Pa) - PathStart); Dirs := Copy (Pa, Succ (PathStart), Length (Pa) - PathStart);
{$IFNDEF FPC_FEXPAND_DIRSEP_IS_CURDIR}
{$IFNDEF FPC_FEXPAND_DIRSEP_IS_UPDIR}
{Before anything else, remove doubled DirectorySeparator characters
- technically invalid or at least useless, but ignored by most operating
systems except for plain DOS.}
I := Pos (DirectorySeparator + DirectorySeparator, Dirs);
while I <> 0 do
begin
J := Succ (I);
while (Length (Dirs) > J) and (Dirs [Succ (J)] = DirectorySeparator) do
Inc (J);
Delete (Dirs, Succ (I), J - I);
I := Pos (DirectorySeparator + DirectorySeparator, Dirs);
end;
{$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR}
{$ENDIF FPC_FEXPAND_DIRSEP_IS_CURDIR}
{$IFNDEF FPC_FEXPAND_NO_CURDIR} {$IFNDEF FPC_FEXPAND_NO_CURDIR}
{$IFNDEF FPC_FEXPAND_DIRSEP_IS_CURDIR} {$IFNDEF FPC_FEXPAND_DIRSEP_IS_CURDIR}
{First remove all references to '\.\'} {First remove all references to '\.\'}

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

@ -397,6 +397,13 @@ if CDir [Length (CDir)] = DirSep then Check ('c:anything', CDir + 'anything')
Check ('..', TestDir + TestDir1Name); Check ('..', TestDir + TestDir1Name);
Check ('.' + DirSep + '..', TestDir + TestDir1Name); Check ('.' + DirSep + '..', TestDir + TestDir1Name);
Check ('..' + DirSep + '.', TestDir + TestDir1Name); Check ('..' + DirSep + '.', TestDir + TestDir1Name);
Check (TestDir + TestDir1Name + DirSep + DirSep + '..' + DirSep, TestDir);
Check (TestDir + TestDir1Name + DirSep + '/' + DirSep + '..' + DirSep, TestDir);
Check (TestDir + TestDir1Name + DirSep + DirSep + DirSep + '..' + DirSep, TestDir);
Check (TestDir + TestDir1Name + DirSep + DirSep + TestDir2Name + DirSep + DirSep + '..',
TestDir + TestDir1Name);
Check (TestDir + TestDir1Name + DirSep + DirSep + TestDir2Name + DirSep + DirSep + '..'
+ DirSep + DirSep, TestDir + TestDir1Name + DirSep);
{$ENDIF NODOTS} {$ENDIF NODOTS}
{$ENDIF MACOS} {$ENDIF MACOS}
{$IFDEF NETWARE} {$IFDEF NETWARE}
@ -474,6 +481,10 @@ if CDir [Length (CDir)] = DirSep then Check ('c:anything', CDir + 'anything')
Check ('d\d/d', CurDir + DirSep + 'd' + DirSep + 'd' + DirSep + 'd'); Check ('d\d/d', CurDir + DirSep + 'd' + DirSep + 'd' + DirSep + 'd');
{$ifdef go32v2} {$ifdef go32v2}
{ for go32v2 target UNC paths are only handled if LFNSupport is true } { for go32v2 target UNC paths are only handled if LFNSupport is true }
{ Remark: The previous statement may not be correct, UNC paths were already }
{ supported with IBM / Microsoft LAN Manager client on plain DOS before LFN }
{ / W95 availability, but that probably doesn't matter for our purposes. }
{ See e.g. http://www.drdobbs.com/undocumented-corner/184408984 (TH). }
if not LFNSupport then if not LFNSupport then
writeln('Go32v2 without LFN, no UNC support') writeln('Go32v2 without LFN, no UNC support')
else else