Browse Source

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

git-svn-id: trunk@39840 -
Tomas Hajny 6 years ago
parent
commit
62b57e81cd
2 changed files with 28 additions and 0 deletions
  1. 17 0
      rtl/inc/fexpand.inc
  2. 11 0
      tests/test/units/dos/tfexpand.pp

+ 17 - 0
rtl/inc/fexpand.inc

@@ -443,6 +443,23 @@ begin
     {Get string of directories to only process relative references on this one}
     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_DIRSEP_IS_CURDIR}
     {First remove all references to '\.\'}

+ 11 - 0
tests/test/units/dos/tfexpand.pp

@@ -397,6 +397,13 @@ if CDir [Length (CDir)] = DirSep then Check ('c:anything', CDir + 'anything')
  Check ('..', 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 MACOS}
 {$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');
 {$ifdef go32v2}
  { 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
    writeln('Go32v2 without LFN, no UNC support')
  else