* ensure that fexpand(ansistring) never converts its argument to a code page

other than DefaultFileSystemCodePage, so that it can work with strings holding any encoding + test for fexpand(ansistring) with UTF-8 strings while DefaultSystemCodePage is set to CP_ASCII git-svn-id: branches/cpstrrtl@25300 -
2025-04-21 18:09:30 +02:00 · 2013-08-19 22:04:15 +00:00 · 2013-08-19 22:04:15 +00:00 · 26b7f5a36c
commit 26b7f5a36c
parent 14d62028ff
3 changed files with 566 additions and 20 deletions
--- a/.gitattributes
+++ b/.gitattributes
@ -12116,6 +12116,7 @@ tests/test/units/sysutils/texec1.pp svneol=native#text/plain
 tests/test/units/sysutils/texec2.pp svneol=native#text/plain
 tests/test/units/sysutils/texpfncase.pp svneol=native#text/plain
 tests/test/units/sysutils/textractquote.pp svneol=native#text/plain
+tests/test/units/sysutils/tfexpand2.pp svneol=native#text/plain
 tests/test/units/sysutils/tfile1.pp svneol=native#text/plain
 tests/test/units/sysutils/tfile2.pp svneol=native#text/plain
 tests/test/units/sysutils/tfilename.pp svneol=native#text/plain
--- a/rtl/inc/fexpand.inc
+++ b/rtl/inc/fexpand.inc
@ -68,7 +68,7 @@ begin
 end;
 {$endif}

-procedure GetDirIO (DriveNr: byte; var Dir: PathStr);
+procedure GetDirIO (DriveNr: byte; var Dir: {$IF defined(FPC_FEXPAND_SYSUTILS) and not defined(SYSUTILSUNICODE)}RawByteString{$else}PathStr{$endif});

 (* GetDirIO is supposed to return the root of the given drive   *)
 (* in case of an error for compatibility of FExpand with TP/BP. *)
@ -85,7 +85,7 @@ end;

 {$IFDEF FPC_FEXPAND_VOLUMES}
 {$IFNDEF FPC_FEXPAND_NO_DEFAULT_PATHS}
-procedure GetDirIO (const VolumeName: OpenString; var Dir: PathStr);
+procedure GetDirIO (const VolumeName: OpenString; var Dir: {$IF defined(FPC_FEXPAND_SYSUTILS) and not defined(SYSUTILSUNICODE)}RawByteString{$else}PathStr{$endif});

 var
  OldInOutRes: word;
@ -128,7 +128,7 @@ const
    RootNotNeeded = false;
 {$ENDIF FPC_FEXPAND_UNC}

-var S, Pa, Dirs: PathStr;
+var S, Pa, Dirs, TmpS: {$IF defined(FPC_FEXPAND_SYSUTILS) and not defined(SYSUTILSUNICODE)}RawByteString{$else}PathStr{$endif};
    I, J: longint;

 begin
@ -137,10 +137,20 @@ begin
 {$ENDIF FPC_FEXPAND_UNC}

 (* First convert the path to uppercase if appropriate for current platform. *)
+{$IF defined(FPC_FEXPAND_SYSUTILS) and not defined(SYSUTILSUNICODE)}
+    { for sysutils/rawbytestring, process everything in
+      DefaultFileSystemCodePage to prevent risking data loss that may be
+      relevant when the file name is used }
+    if FileNameCasePreserving then
+        Pa := ToSingleByteFileSystemEncodedFileName (Path)
+    else
+        Pa := UpCase (ToSingleByteFileSystemEncodedFileName (Path));
+{$ELSE FPC_FEXPAND_SYSUTILS and not SYSUTILSUNICODE}
    if FileNameCasePreserving then
        Pa := Path
    else
        Pa := UpCase (Path);
+{$ENDIF FPC_FEXPAND_SYSUTILS and not SYSUTILSUNICODE}

 (* Allow both '/' and '\' as directory separators *)
 (* by converting all to the native one.           *)
@ -171,7 +181,11 @@ begin
                      ((Pa [2] = DirectorySeparator) or (Length (Pa) = 1)) then
        begin
 {$IFDEF FPC_FEXPAND_SYSUTILS}
-            S := GetEnvironmentVariable ('HOME');
+   {$IFDEF SYSUTILSUNICODE}
+            S := PathStr(GetEnvironmentVariable ('HOME'));
+   {$ELSE SYSUTILSUNICODE}
+            S := ToSingleByteFileSystemEncodedFileName(GetEnvironmentVariable ('HOME'));
+   {$ENDIF SYSUTILSUNICODE}
 {$ELSE FPC_FEXPAND_SYSUTILS}
  {$IFDEF FPC_FEXPAND_GETENV_PCHAR}
            S := StrPas (GetEnv ('HOME'));
@ -230,19 +244,38 @@ begin
                        begin
                            { remove ending slash if it already exists }
                            if S [Length (S)] = DirectorySeparator then
-                               SetLength(S,Length(s)-1);
+                               SetLength(S,Length(S)-1);
+{$IFDEF FPC_FEXPAND_SYSUTILS}
+                            { not "Pa := S + DirectorySeparator + ..." because
+                              that will convert the result to
+                              DefaultSystemCodePage in case of RawByteString due
+                              to DirectorySeparator being an ansichar }
+                            TmpS := S;
+                            SetLength(TmpS, Length(TmpS) + 1);
+                            TmpS[Length(TmpS)] := DirectorySeparator;
+                            Pa := TmpS +
+                              Copy (Pa, PathStart, Length (Pa) - PathStart + 1)
+{$ELSE FPC_FEXPAND_SYSUTILS}
                            Pa := S + DirectorySeparator +
                              Copy (Pa, PathStart, Length (Pa) - PathStart + 1)
+{$ENDIF FPC_FEXPAND_SYSUTILS}
                        end
                    else
+                      begin
+                        TmpS := DriveSeparator + DirectorySeparator;
+  {$IF defined(FPC_FEXPAND_SYSUTILS) and not defined(SYSUTILSUNICODE)}
+                        SetCodePage(TmpS, DefaultFileSystemCodePage, false);
+  {$ENDIF FPC_FEXPAND_SYSUTILS and not SYSUTILSUNICODE}
+
  {$IFDEF FPC_FEXPAND_VOLUMES}
-                        Pa := Copy (Pa, 1, PathStart - 2) + DriveSeparator
-                           + DirectorySeparator +
+                        Pa := Copy (Pa, 1, PathStart - 2) + TmpS +
                              Copy (Pa, PathStart, Length (Pa) - PathStart + 1)
  {$ELSE FPC_FEXPAND_VOLUMES}
-                        Pa := Pa [1] + DriveSeparator + DirectorySeparator +
+                        { copy() instead of Pa[1] to preserve string code page }
+                        Pa := Copy (Pa, 1, 1) + TmpS +
                              Copy (Pa, PathStart, Length (Pa) - PathStart + 1)
  {$ENDIF FPC_FEXPAND_VOLUMES}
+                      end
 {$ENDIF FPC_FEXPAND_NO_DEFAULT_PATHS}
        end
    else
@ -295,8 +328,17 @@ begin
                                {...or not even that one}
                                    PathStart := 2
                                else
-                                    Pa := Pa + DirectorySeparator                            else
-                                if PathStart < Length (Pa) then
+                                  begin
+    {$IFDEF FPC_FEXPAND_SYSUTILS}
+                                    { no string concatenation to prevent code page
+                                      conversion for RawByteString }
+                                    SetLength(Pa, Length(Pa) + 1);
+                                    Pa[Length(Pa)] := DirectorySeparator
+    {$ELSE FPC_FEXPAND_SYSUTILS}
+                                    Pa := Pa + DirectorySeparator;
+    {$ENDIF FPC_FEXPAND_SYSUTILS}
+                                  end
+                                else if PathStart < Length (Pa) then
                                {We have a resource name as well}
                                    begin
                                        RootNotNeeded := true;
@ -309,8 +351,8 @@ begin
                        end
                    else
  {$ENDIF FPC_FEXPAND_UNC}
-  {$IFDEF FPC_FEXPAND_VOLUMES}
                        begin
+  {$IFDEF FPC_FEXPAND_VOLUMES}
                            I := Pos (DriveSeparator, S);
   {$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR}
    {$IFDEF FPC_FEXPAND_DRIVESEP_IS_ROOT}
@ -320,13 +362,20 @@ begin
                            Pa := Copy (S, 1, I) + Pa;
                            PathStart := I;
   {$ELSE FPC_FEXPAND_DIRSEP_IS_UPDIR}
-                            Pa := Copy (S, 1, Pred (I)) + DriveSeparator + Pa;
+                            TmpS := Copy (S, 1, Pred (I));
+                            SetLength(TmpS, Length(TmpS) + 1);
+                            TmpS[Length(TmpS)] := DriveSeparator;
+                            Pa := TmpS + Pa;
                            PathStart := Succ (I);
   {$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR}
-                        end;
  {$ELSE FPC_FEXPAND_VOLUMES}
-                        Pa := S [1] + DriveSeparator + Pa;
+                            TmpS := S[1] + DriveSeparator;
+  {$IF defined(FPC_FEXPAND_SYSUTILS) and not defined(SYSUTILSUNICODE)}
+                            SetCodePage(TmpS, DefaultFileSystemCodePage, false);
+  {$ENDIF FPC_FEXPAND_SYSUTILS and not SYSUTILSUNICODE}
+                            Pa := TmpS + Pa;
  {$ENDIF FPC_FEXPAND_VOLUMES}
+                        end;
                end
            else
 {$ENDIF FPC_FEXPAND_DRIVES}
@ -346,18 +395,42 @@ begin
                    (* with an empty string for compatibility, except *)
                    (* for platforms where this is invalid.           *)
                    if Length (Pa) = 0 then
-{$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR}
-                        Pa := S
-{$ELSE FPC_FEXPAND_DIRSEP_IS_UPDIR}
-                        Pa := S + DirectorySeparator
-{$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR}
+                      begin
+                        Pa := S;
+{$IFNDEF FPC_FEXPAND_DIRSEP_IS_UPDIR}
+  {$IFDEF FPC_FEXPAND_SYSUTILS}
+                        { no string concatenation to prevent code page
+                          conversion for RawByteString }
+                        SetLength(Pa, Length(Pa) + 1);
+                        Pa[Length(Pa)] := DirectorySeparator
+  {$ELSE FPC_FEXPAND_SYSUTILS}
+                        Pa := Pa + DirectorySeparator;
+  {$ENDIF FPC_FEXPAND_SYSUTILS}
+{$ENDIF not FPC_FEXPAND_DIRSEP_IS_UPDIR}
+                      end
                    else
 {$IFDEF FPC_FEXPAND_UPDIR_HELPER}
                        if Pa [1] = DirectorySeparator then
                            Pa := S + Pa
                        else
 {$ENDIF FPC_FEXPAND_UPDIR_HELPER}
-                        Pa := S + DirectorySeparator + Pa;
+                          begin
+{$IFDEF FPC_FEXPAND_SYSUTILS}
+                            { not "Pa := S + DirectorySeparator + Pa" because
+                              that will convert the result to
+                              DefaultSystemCodePage in case of RawByteString due
+                              to DirectorySeparator being an ansichar. Don't
+                              always use this code because in case of
+                              truncation with shortstrings the result will be
+                              different }
+                            TmpS := S;
+                            SetLength(TmpS, Length(TmpS) + 1);
+                            TmpS[Length(TmpS)] := DirectorySeparator;
+                            Pa := TmpS + Pa;
+{$ELSE FPC_FEXPAND_SYSUTILS}
+                            Pa := S + DirectorySeparator + Pa
+{$ENDIF FPC_FEXPAND_SYSUTILS}
+                          end;
        end;

    {Get string of directories to only process relative references on this one}
@ -495,7 +568,16 @@ begin
            Pa := Copy (Pa, 1, PathStart);
 {$IFNDEF FPC_FEXPAND_DRIVESEP_IS_ROOT}
            if Pa [PathStart] <> DirectorySeparator then
+              begin
+  {$IFDEF FPC_FEXPAND_SYSUTILS}
+                { no string concatenation to prevent code page
+                  conversion for RawByteString }
+                SetLength(Pa, Length(Pa) + 1);
+                Pa[Length(Pa)] := DirectorySeparator
+  {$ELSE FPC_FEXPAND_SYSUTILS}
                Pa := Pa + DirectorySeparator;
+  {$ENDIF FPC_FEXPAND_SYSUTILS}
+              end
 {$ENDIF FPC_FEXPAND_DRIVESEP_IS_ROOT}
        end
    else
--- a/tests/test/units/sysutils/tfexpand2.pp
+++ b/tests/test/units/sysutils/tfexpand2.pp
@ -0,0 +1,463 @@
+{ %target=linux,freebsd,openbsd,netbsd,win32,win64,darwin,haiku,morphos }
+
+{
+    This file is part of the Free Pascal test suite.
+    Copyright (c) 1999-2004 by the Free Pascal development team.
+
+    Test for possible bugs in SysUtils.ExpandFileName
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$codepage utf8}
+
+program TFExpand;
+
+{$DEFINE DEBUG}
+(* Defining DEBUG causes all the source and target strings *)
+(* to be written to the console to make debugging easier.  *)
+
+uses
+{$ifdef FPC}
+ PopupErr,
+{$endif FPC}
+{$ifdef unix}
+ cwstring,
+{$endif}
+ SysUtils;
+
+{$IFDEF LINUX}
+ {$IFNDEF UNIX}
+  {$DEFINE UNIX}
+ {$ENDIF UNIX}
+{$ENDIF LINUX}
+
+{$IFDEF AMIGA}
+ {$DEFINE VOLUMES}
+ {$DEFINE NODRIVEC}
+{$ENDIF AMIGA}
+
+{$IFDEF NETWARE}
+ {$DEFINE VOLUMES}
+ {$DEFINE NODRIVEC}
+{$ENDIF NETWARE}
+
+{$IFDEF UNIX}
+ {$DEFINE NODRIVEC}
+{$ENDIF UNIX}
+
+{$IFDEF MACOS}
+ {$DEFINE VOLUMES}
+ {$DEFINE NODRIVEC}
+ {$DEFINE NODOTS}
+{$ENDIF MACOS}
+
+const
+{$IFNDEF NODRIVEC}
+ CC = UTF8String('C:');
+{$ENDIF NODRIVEC}
+{$IFNDEF FPC}
+ FileNameCasePreserving = false;
+ DirectorySeparator = '\';
+ DirectorySeparator2 = '\';
+ DirSep = '\';
+ CDrive = 'C:';
+ DriveSep = ':';
+{$ELSE FPC}
+(* Used for ChDir/MkDir *)
+ DirectorySeparator2 = UTF8String(System.DirectorySeparator);
+ {$IFDEF DIRECT}
+  {$IFDEF MACOS}
+ DirectorySeparator = UTF8String(':');
+ LFNSupport = true;
+ FileNameCasePreserving = true;
+  {$ELSE MACOS}
+   {$IFDEF UNIX}
+ DirectorySeparator = UTF8String('/');
+ DriveSeparator = UTF8String('/');
+ FileNameCasePreserving = true;
+   {$ELSE UNIX}
+    {$IFDEF AMIGA}
+ DirectorySeparator = UTF8String(':');
+ FileNameCasePreserving = true;
+    {$ELSE AMIGA}
+ DirectorySeparator = UTF8String('\');
+ FileNameCasePreserving = false;
+    {$ENDIF AMIGA}
+   {$ENDIF UNIX}
+  {$ENDIF MACOS}
+ {$ENDIF DIRECT}
+ DirSep = UTF8String(DirectorySeparator);
+ {$IFDEF MACOS}
+ DriveSep = '';
+ {$ELSE MACOS}
+  {$IFDEF AMIGA}
+ DriveSep = '';
+  {$ELSE AMIGA}
+ DriveSep = DriveSeparator;
+  {$ENDIF AMIGA}
+ {$ENDIF MACOS}
+ {$IFDEF UNIX}
+ CDrive = '';
+ {$ELSE UNIX}
+  {$IFDEF MACOS}
+ CDrive = UTF8String('C');
+  {$ELSE MACOS}
+   {$IFDEF AMIGA}
+ CDrive = UTF8String('C');
+   {$ELSE AMIGA}
+ CDrive = UTF8String('C:');
+   {$ENDIF AMIGA}
+  {$ENDIF MACOS}
+ {$ENDIF UNIX}
+{$ENDIF FPC}
+ TestFileName = UTF8String('™estfilê.™st');
+ TestDir1Name = UTF8String('TÊS™DIR1');
+ TestDir2Name = UTF8String('TE∑™DIR2');
+ HasErrors: boolean = false;
+
+
+var
+{$IFNDEF NODRIVEC}
+ CDir,
+{$endif}
+ TestDir, TestDir0, OrigDir, OrigTstDir, CurDir, S: UTF8String;
+ TestDrive: UTF8String;
+ I: byte;
+ IOR: longint;
+ F: file;
+
+function Translate (S: rawbytestring): rawbytestring;
+var
+ I: byte;
+begin
+{$IFDEF UNIX}
+ if (Length (S) > 1) and (S [2] = ':') then Delete (S, 1, 2);
+{$ELSE UNIX}
+ for I := 1 to Length (S) do if S [I] = '/' then S [I] := DirSep[1];
+ if (Length (S) > 1) and (S [1] in ['a'..'z']) and (S[2]=DriveSep) then
+   S [1] := UpCase (S [1]);
+{$ENDIF UNIX}
+ if not (FileNameCasePreserving) then
+   for I := 1 to Length (S) do S [I] := UpCase (S [I]);
+ Translate := S;
+end;
+
+procedure Check (Src, Rslt: rawbytestring);
+var
+ Rslt2: rawbytestring;
+begin
+{$IFDEF DEBUG}
+ WriteLn (Src, '=>', Rslt);
+{$ENDIF DEBUG}
+ Rslt := Translate (Rslt);
+ Rslt2 := ExpandFileName (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}
+ if (Length (Rslt2) > 1) and (Rslt2 [1] in ['a'..'z']) and (Rslt2[2]=DriveSep) then
+   Rslt2 [1] := UpCase (Rslt2 [1]);
+{$ENDIF NDEF UNIX}
+ if Rslt <> Rslt2 then
+ begin
+  WriteLn ('Error: ExpandFileName (', Src, ') should be "', Rslt, '", not "',
+                                                                   Rslt2, '"');
+  HasErrors := true;
+ end;
+end;
+
+begin
+ { ensure ExpandFileName doesn't lose data when the file system can represent all characters }
+ DefaultFileSystemCodePage:=CP_UTF8;
+ DefaultRTLFileSystemCodePage:=CP_UTF8;
+ { ensure we do lose data if we somewhere accidentally use the default system code page
+   to perform operations }
+ DefaultSystemCodePage:=CP_ASCII;
+ if ParamCount <> 1 then
+ begin
+  WriteLn ('Warning: Parameter missing!');
+  WriteLn ('Full path to a directory with write access' +
+{$IFNDEF UNIX}
+ {$IFNDEF VOLUMES}
+                               #13#10'(preferably not on a C: drive)' +
+ {$ENDIF VOLUMES}
+{$ENDIF UNIX}
+                                                                 ' expected.');
+  WriteLn ('Trying to use the current directory instead ' +
+{$IFDEF UNIX}
+                                                         '(not quite ideal).');
+{$ELSE UNIX}
+                                                    '(problems might arise).');
+{$ENDIF UNIX}
+{$IFDEF DIRECT}System.{$ENDIF DIRECT}GetDir (0, TestDir);
+ end else TestDir := ParamStr (1);
+ if TestDir [Length (TestDir)] <> DirectorySeparator2 then
+  TestDir := TestDir + DirectorySeparator2;
+GetDir (0, OrigDir);
+{$IFDEF NODRIVEC}
+ TestDrive := '';
+{$ELSE NODRIVEC}
+ TestDrive := Copy (TestDir, 1, 2);
+ GetDir ((Ord (TestDir [1]) and not ($20)) - 64, OrigTstDir);
+{$ENDIF NODRIVEC}
+{$I-}
+ MkDir (TestDir + TestDir1Name);
+ if IOResult <> 0 then ;
+ MkDir (TestDir + TestDir1Name + DirectorySeparator2 + TestDir2Name);
+ if IOResult <> 0 then ;
+{$I+}
+ ChDir (TestDir + TestDir1Name + DirectorySeparator2 + TestDir2Name);
+{$I-}
+ TestDir0 := TestDir;
+ Assign (F, TestFileName);
+ Rewrite (F);
+ Close (F);
+ if IOResult <> 0 then ;
+ { prevent conversion of TestFileName to ansi code page in case of
+   ExpandFileName(ansistring) }
+ Assign (F, ExpandFileName (RawByteString(TestFileName)));
+{$I+}
+ GetDir (0, CurDir);
+{$IFNDEF NODRIVEC}
+ GetDir (3, CDir);
+{$ENDIF NODRIVEC}
+ Check (' ', CurDir + DirSep + ' ');
+{$IFDEF AMIGA}
+ Check ('', CurDir);
+{$ELSE AMIGA}
+ Check ('', CurDir + DirSep);
+{$ENDIF AMIGA}
+{$IFDEF MACOS}
+ Check (':', CurDir + DirSep);
+{$ELSE MACOS}
+ Check ('.', CurDir);
+{$ENDIF MACOS}
+
+{$IFNDEF NODRIVEC}
+if CDir [Length (CDir)] = DirSep then Check ('c:anything', CDir + 'anything')
+                         else Check ('c:anything', CDir + DirSep + 'anything');
+ Check (CC + DirSep, CDrive + DirSep);
+{$IFDEF NODOTS}
+ Check ('C:.', 'C:.');
+ Check (CC + DirSep + '.', CDrive + DirSep + '.');
+ Check (CC + DirSep + '..', CDrive + DirSep + '..');
+{$ELSE NODOTS}
+ Check ('C:.', CDir);
+ Check (CC + DirSep + '.', CDrive + DirSep);
+ Check (CC + DirSep + '..', CDrive + DirSep);
+{$ENDIF NODOTS}
+ Check (CC + DirSep + UTF8String('∂œ∑'), CDrive + DirSep + UTF8String('∂œ∑'));
+{$IFNDEF NODOTS}
+ Check (CC + DirSep + '..' + DirSep + UTF8String('∂œ∑'), CDrive + DirSep + UTF8String('∂œ∑'));
+{$ENDIF NODOTS}
+ Check (CC + DirSep + 'DOS.', CDrive + DirSep + 'DOS.');
+{$IFDEF AMIGA}
+ Check (CC + DirSep + UTF8String('∂œ∑') + DirSep, CDrive + DirSep);
+{$ELSE AMIGA}
+ Check (CC + DirSep + UTF8String('∂œ∑') + DirSep, CDrive + DirSep + UTF8String('∂œ∑') + DirSep);
+{$ENDIF AMIGA}
+{$IFNDEF NODOTS}
+ Check (CC + DirSep + UTF8String('∂œ∑') + DirSep + '.', CDrive + DirSep + UTF8String('∂œ∑'));
+ Check (CC + DirSep + UTF8String('∂œ∑') + DirSep + '..', CDrive + DirSep);
+ Check (CC + DirSep + UTF8String('∂œ∑') + DirSep + '..' + DirSep, CDrive + DirSep);
+ Check (CC + DirSep + UTF8String('∂œ∑') + DirSep + UTF8String('†ĘŚ™') + DirSep + '..', CDrive +
+                                                               DirSep + UTF8String('∂œ∑'));
+ Check (CC + DirSep + UTF8String('∂œ∑') + DirSep + UTF8String('†ĘŚ™') + DirSep + '..' + DirSep,
+                                             CDrive + DirSep + UTF8String('∂œ∑') + DirSep);
+{$ENDIF NODOTS}
+{$ENDIF NODRIVEC}
+
+{$IFNDEF MACOS}
+ Check (DirSep, TestDrive + DirSep);
+ Check (DirSep + '.', TestDrive + DirSep);
+ Check (DirSep + '..', TestDrive + DirSep);
+ Check (DirSep + UTF8String('∂œ∑'), TestDrive + DirSep + UTF8String('∂œ∑'));
+{$ENDIF MACOS}
+ Check (UTF8String('∆'), CurDir + DirSep + UTF8String('∆'));
+{$IFDEF MACOS}
+ Check (DirSep + UTF8String('∆'), CurDir + DirSep + UTF8String('∆'));
+{$ELSE MACOS}
+ {$IFNDEF NODOTS}
+ Check ('.' + DirSep + UTF8String('∆'), CurDir + DirSep + UTF8String('∆'));
+ {$ENDIF NODOTS}
+{$ENDIF MACOS}
+ Check (UTF8String('∆') + DirSep + TestFileName, CurDir + DirSep + UTF8String('∆') + DirSep + TestFileName);
+ Check (UTF8String(' ∆'), CurDir + DirSep + UTF8String(' ∆'));
+ Check (UTF8String('∆∆'), CurDir + DirSep + UTF8String('∆∆'));
+{$IFDEF MACOS}
+ Check (DirSep + UTF8String('∆∆') + DirSep + UTF8String('∆∆'), CurDir + DirSep + UTF8String('∆∆') + DirSep + UTF8String('∆∆'));
+ Check (UTF8String('∆∆') + DirSep + UTF8String('∆∆'), UTF8String('∆∆') + DirSep + UTF8String('∆∆'));
+{$ELSE MACOS}
+ Check (UTF8String('∆∆') + DirSep + UTF8String('∆∆'), CurDir + DirSep + UTF8String('∆∆') + DirSep + UTF8String('∆∆'));
+{$ENDIF MACOS}
+ Check (UTF8String('∂∂∂'), CurDir + DirSep + UTF8String('∂∂∂'));
+{$IFDEF MACOS}
+ Check (UTF8String('∂∂∂∂') + DirSep + UTF8String('ÊÊÊÊ.ƒƒƒƒ'), UTF8String('∂∂∂∂') + DirSep + UTF8String('ÊÊÊÊ.ƒƒƒƒ'));
+{$ELSE MACOS}
+ Check (UTF8String('∂∂∂∂') + DirSep + UTF8String('ÊÊÊÊ.ƒƒƒƒ'), CurDir + DirSep + UTF8String('∂∂∂∂') + DirSep
+                                                                + UTF8String('ÊÊÊÊ.ƒƒƒƒ'));
+{$ENDIF MACOS}
+ Check (UTF8String(UTF8String('.∑πê©îæ¬')), CurDir + DirSep + UTF8String(UTF8String('.∑πê©îæ¬')));
+ Check (UTF8String('..∑πê©îæ¬'), CurDir + DirSep + UTF8String('..∑πê©îæ¬'));
+ Check (UTF8String('∑πê©îæ¬..'), CurDir + DirSep + UTF8String('∑πê©îæ¬..'));
+{$IFDEF AMIGA}
+ Check (UTF8String('∑πê©îæ¬.') + DirSep, CurDir);
+{$ELSE AMIGA}
+ {$IFDEF MACOS}
+ Check (UTF8String('∑πê©îæ¬.') + DirSep, UTF8String('∑πê©îæ¬.') + DirSep);
+ {$ELSE MACOS}
+ Check (UTF8String('∑πê©îæ¬.') + DirSep, CurDir + DirSep + UTF8String('∑πê©îæ¬.') + DirSep);
+ {$ENDIF MACOS}
+{$ENDIF AMIGA}
+{$IFDEF MACOS}
+ Check (DirSep + DirSep, TestDir + TestDir1Name + DirSep);
+ Check (DirSep + DirSep + TestFileName, TestDir + TestDir1Name + DirSep
+                                                               + TestFileName);
+{$ELSE MACOS}
+ Check (DirSep + UTF8String('.∑πê©îæ¬'), TestDrive + DirSep + UTF8String(UTF8String('.∑πê©îæ¬')));
+ {$IFNDEF NODOTS}
+ Check ('..', TestDir + TestDir1Name);
+ Check ('.' + DirSep + '..', TestDir + TestDir1Name);
+ Check ('..' + DirSep + '.', TestDir + TestDir1Name);
+ {$ENDIF NODOTS}
+{$ENDIF MACOS}
+{$IFDEF NETWARE}
+ Check ('...', TestDir);
+{$ELSE NETWARE}
+ Check ('...', CurDir + DirSep + '...');
+{$ENDIF NETWARE}
+ Check (TestFileName, CurDir + DirSep + TestFileName);
+{$IFDEF UNIX}
+ S := GetEnvironmentVariable ('HOME');
+ { On m68k netbsd at least, HOME contains a final slash
+   remove it PM }
+ if (Length (S) > 1) and (S [Length (S)] = DirSep) then
+   S:=Copy(S,1,Length(S)-1);
+ if Length (S) = 0 then
+  begin
+   Check ('~', CurDir);
+   Check ('~' + DirSep + '.', DirSep);
+  end
+ else
+  begin
+   Check ('~', S);
+   Check ('~' + DirSep + '.', S);
+  end;
+ if (Length (S) > 0) and (S [Length (S)] <> DirSep) then
+  S := S + DirSep;
+ Check (UTF8String('~ıœßodyWithThisNameShouldEverExist.test/nothinﬂ'), CurDir + DirSep +
+                            UTF8String('~ıœßodyWithThisNameShouldEverExist.test/nothinﬂ'));
+ Check ('/tmp/~NoSº©hUse®Again', '/tmp/~NoSº©hUse®Again');
+ if Length (S) = 0 then
+  begin
+   Check ('~' + DirSep, DirSep);
+   Check ('~' + DirSep + '.' + DirSep, DirSep);
+   Check ('~' + DirSep + UTF8String('∂î®ê©†œ®Ú') + DirSep + UTF8String('anothe®'),
+                                    DirSep + UTF8String('∂î®ê©†œ®Ú') + DirSep + UTF8String('anothe®'));
+  end
+ else
+  begin
+   Check ('~' + DirSep, S);
+   Check ('~' + DirSep + '.' + DirSep, S);
+   Check ('~' + DirSep + UTF8String('∂î®ê©†œ®Ú') + DirSep + UTF8String('anothe®'),
+                                         S + UTF8String('∂î®ê©†œ®Ú') + DirSep + UTF8String('anothe®'));
+  end;
+{$ELSE UNIX}
+ {$IFNDEF NODRIVEC}
+ Check (TestDrive + '..', TestDir + TestDir1Name);
+ Check (TestDrive + '..' + DirSep, TestDir + TestDir1Name + DirSep);
+ Check (TestDrive + '.' + DirSep + '.', CurDir);
+ Check (TestDrive + '.' + DirSep + '..', TestDir + TestDir1Name);
+{$I-}
+(*
+{ $ ifndef unix }
+{   avoid a and b drives for
+   no unix systems to reduce the
+   probablility of getting an alert message box }
+ { This should not be needed - unit popuperr should solve this?! TH }
+ I := 3;
+{$else unix} *)
+ I := 1;
+{ $ endif unix}
+ 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 := UTF8String(Chr (I + 64)) + UTF8String(':∂∂∂');
+  Check (S, UTF8String(Chr (I + 64)) + UTF8String(':') + DirSep + UTF8String('∂∂∂'));
+ end else
+   WriteLn ('Sorry, cannot test ExpandFileName behaviour for incorrect drives here.');
+{$I+}
+  {$IFDEF FPC}
+ Check ('∆\∆/∆', CurDir + DirSep + UTF8String('∆') + DirSep + UTF8String('∆') + DirSep + UTF8String('∆'));
+ Check ('\\serve®\sha®e\di®ectory', '\\serve®\sha®e\di®ectory');
+ Check ('\\serve®\sha®e\directo®y1\directo®y2\..',
+                                                  '\\serve®\sha®e\directo®y1');
+ Check ('\\', '\\');
+ Check ('\\.', '\\.\');
+ Check ('\\.\', '\\.\');
+ Check ('\\.\.', '\\.\.');
+ Check ('\\.\..', '\\.\..');
+ Check ('\\.\...', '\\.\...');
+ Check ('\\.\†êÒ™', '\\.\†êÒ™');
+ Check ('\\..\', '\\..\');
+ Check ('\\..\†êÒ™', '\\..\†êÒ™');
+ Check ('\\..\†êÒ™\.', '\\..\†êÒ™');
+ Check ('\\..\†êÒ™1\TÊ∑T2\..', '\\..\†êÒ™1');
+ Check ('\\..\†êÒ™\..', '\\..\†êÒ™');
+ Check ('\\..\†êÒ™\..\..', '\\..\†êÒ™');
+  {$ENDIF FPC}
+ {$ENDIF NODRIVEC}
+{$ENDIF UNIX}
+{$IFDEF VOLUMES}
+ Check (UTF8String('√olıame') + DriveSep + DirSep + UTF8String('∆Î®1'), UTF8String('√olıame') + DriveSep + DirSep + UTF8String('∆Î®1'));
+ {$IFNDEF NODOTS}
+ Check (UTF8String('√olıame') + DriveSep + DirSep + UTF8String('∆Î®1') + DirSep + '..', UTF8String('√olıame') + DriveSep + DirSep);
+ Check (UTF8String('√olıame') + DriveSep + DirSep + UTF8String('∆Î®1') + DirSep + '..' + DirSep + '..',
+                                                          UTF8String('√olıame') + DriveSep + DirSep);
+ Check (UTF8String('√olıame') + DriveSep + DirSep + '.', UTF8String('√olıame:') + DirSep);
+ Check (UTF8String('√olıame') + DriveSep + DirSep + '..', UTF8String('√olıame:') + DirSep);
+ Check (UTF8String('√olıame') + DriveSep + DirSep + '..' + DirSep, UTF8String('√olıame') + DriveSep + DirSep);
+ {$ENDIF NODOTS}
+ {$IFDEF NETWARE}
+ Check (UTF8String('∑rvName\√olıame') + DriveSep + DirSep + UTF8String('†ĘŚ™'), UTF8String('∑rvName') + DirSep + UTF8String('√olıame') +
+                                                         DriveSep + DirSep + UTF8String('†ĘŚ™'));
+ Check (UTF8String('∑rvName/√olıame') + DriveSep + DirSep + UTF8String('†ĘŚ™'), UTF8String('∑rvName') + DirSep + UTF8String('√olıame') +
+                                                         DriveSep + DirSep + UTF8String('†ĘŚ™'));
+ {$ENDIF NETWARE}
+ {$IFDEF AMIGA}
+  {$IFDEF NODOTS}
+ Check ('.', CurDir + DirSep + '.');
+  {$ELSE NODOTS}
+ Check ('.', CurDir);
+  {$ENDIF NODOTS}
+ {$ENDIF AMIGA}
+{$ENDIF VOLUMES}
+ Erase (F);
+{$IFNDEF NODRIVEC}
+ ChDir (OrigTstDir);
+{$ENDIF NODRIVEC}
+ ChDir (OrigDir);
+ RmDir (TestDir0 + TestDir1Name + DirectorySeparator2 + TestDir2Name);
+ RmDir (TestDir0 + TestDir1Name);
+ if HasErrors then
+ begin
+  WriteLn ('ExpandFileName doesn''t work correctly.');
+  Halt (1);
+ end;
+end.