Browse Source

+ added mkdir/chdir/rmdir(rawbytestring) and (unicodestring) to the system unit
* renamed platform-specific pchar versions of those rouines to do_*() and
changed them to either rawbytestring or unicodestring depending on the
FPCRTL_FILESYSTEM_SINGLE_BYTE_API/FPCRTL_FILESYSTEM_TWO_BYTE_API setting
* implemented generic shortstring versions of those routines on top of either
rawbytestring or unicodestring depending on the API-kind (in case of the
embedded target, if ansistring are not supported they will map directly
to shortstring routines instead)
* all platform-specific *dir() routines with rawbytestring parameters now
receive their parameters in DefaultFileSystemCodePage
- removed no longer required ansistring variants from the objpas unit
- removed no longer required FPC_SYS_MKDIR etc aliases
* factored out empty string and inoutres<>0 checks from platform-specific
*dir() routines to generic ones
o platform-specific notes:
o amiga/morphos: check new pathconv(rawbytestring) function
o macos TODO: convert PathArgToFSSpec (and the routines it calls) to
rawbytestring
o nativent: added SysUnicodeStringToNtStr() function
o wii: convert dirio callbacks to use rawbytestring to avoid conversion
+ test for unicode mk/ch/rm/getdir()

git-svn-id: branches/cpstrrtl@25048 -

Jonas Maebe 12 years ago
parent
commit
d66d15aad3

+ 1 - 0
.gitattributes

@@ -12031,6 +12031,7 @@ tests/test/units/system/tassert6.pp svneol=native#text/plain
 tests/test/units/system/tassert7.pp svneol=native#text/plain
 tests/test/units/system/tassert7.pp svneol=native#text/plain
 tests/test/units/system/tassignd.pp svneol=native#text/plain
 tests/test/units/system/tassignd.pp svneol=native#text/plain
 tests/test/units/system/tdir.pp svneol=native#text/plain
 tests/test/units/system/tdir.pp svneol=native#text/plain
+tests/test/units/system/tdir2.pp svneol=native#text/plain
 tests/test/units/system/testmac.txt svneol=native#text/plain
 tests/test/units/system/testmac.txt svneol=native#text/plain
 tests/test/units/system/testpc.txt svneol=native#text/plain
 tests/test/units/system/testpc.txt svneol=native#text/plain
 tests/test/units/system/teststk.pp svneol=native#text/plain
 tests/test/units/system/teststk.pp svneol=native#text/plain

+ 18 - 24
rtl/amiga/sysdir.inc

@@ -3,7 +3,7 @@
     Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski
     Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski
     member of the Free Pascal development team.
     member of the Free Pascal development team.
 
 
-    FPC Pascal system unit for the Win32 API.
+    FPC Pascal system unit for Amiga.
 
 
     See the file COPYING.FPC, included in this distribution,
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
     for details about the copyright.
@@ -18,15 +18,14 @@
 {*****************************************************************************
 {*****************************************************************************
                            Directory Handling
                            Directory Handling
 *****************************************************************************}
 *****************************************************************************}
-procedure mkdir(s : pchar; len : sizeuint); [IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+procedure do_mkdir(const s : rawbytestring);
 var
 var
-  tmpStr : array[0..255] of char;
+  tmpStr : rawbytestring;
   tmpLock: LongInt;
   tmpLock: LongInt;
 begin
 begin
   checkCTRLC;
   checkCTRLC;
-  if (s='') or (InOutRes<>0) then exit;
-  tmpStr:=PathConv(s)+#0;
-  tmpLock:=dosCreateDir(@tmpStr);
+  tmpStr:=PathConv(s);
+  tmpLock:=dosCreateDir(pchar(tmpStr));
   if tmpLock=0 then begin
   if tmpLock=0 then begin
     dosError2InOut(IoErr);
     dosError2InOut(IoErr);
     exit;
     exit;
@@ -34,33 +33,35 @@ begin
   UnLock(tmpLock);
   UnLock(tmpLock);
 end;
 end;
 
 
-procedure rmdir(s : pchar; len : sizeuint); [IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+procedure do_rmdir(const s : rawbytestring);
 var
 var
-  tmpStr : array[0..255] of Char;
+  tmpStr : rawbytestring;
 begin
 begin
   checkCTRLC;
   checkCTRLC;
-  if (s='.') then InOutRes:=16;
-  If (s='') or (InOutRes<>0) then exit;
-  tmpStr:=PathConv(s)+#0;
-  if not dosDeleteFile(@tmpStr) then
+  if (s='.') then
+    begin
+      InOutRes:=16;
+      exit;
+    end;
+  tmpStr:=PathConv(s);
+  if not dosDeleteFile(pchar(tmpStr)) then
     dosError2InOut(IoErr);
     dosError2InOut(IoErr);
 end;
 end;
 
 
-procedure sys_chdir(s : pchar);
+procedure do_ChDir(const s: rawbytestring);
 var
 var
-  tmpStr : array[0..255] of Char;
+  tmpStr : rawbytestring;
   tmpLock: LongInt;
   tmpLock: LongInt;
   FIB    : PFileInfoBlock;
   FIB    : PFileInfoBlock;
 begin
 begin
   checkCTRLC;
   checkCTRLC;
-  If (s='') or (InOutRes<>0) then exit;
-  tmpStr:=PathConv(s)+#0;
+  tmpStr:=PathConv(s);
   tmpLock:=0;
   tmpLock:=0;
 
 
   { Changing the directory is a pretty complicated affair }
   { Changing the directory is a pretty complicated affair }
   {   1) Obtain a lock on the directory                   }
   {   1) Obtain a lock on the directory                   }
   {   2) CurrentDir the lock                              }
   {   2) CurrentDir the lock                              }
-  tmpLock:=Lock(@tmpStr,SHARED_LOCK);
+  tmpLock:=Lock(pchar(tmpStr),SHARED_LOCK);
   if tmpLock=0 then begin
   if tmpLock=0 then begin
     dosError2InOut(IoErr);
     dosError2InOut(IoErr);
     exit;
     exit;
@@ -81,13 +82,6 @@ begin
   if assigned(FIB) then dispose(FIB);
   if assigned(FIB) then dispose(FIB);
 end;
 end;
 
 
-Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
-begin
-  If not assigned(s) or (len=0) or (InOutRes <> 0) then
-    exit;
-  sys_chdir(s);
-end;
-
 procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);
 procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);
 var tmpbuf: array[0..255] of char;
 var tmpbuf: array[0..255] of char;
 begin
 begin

+ 25 - 5
rtl/embedded/sysdir.inc

@@ -19,29 +19,49 @@
 {*****************************************************************************
 {*****************************************************************************
                            Directory Handling
                            Directory Handling
 *****************************************************************************}
 *****************************************************************************}
-procedure mkdir(s: pchar;len:sizeuint);[IOCheck];
+{$if defined(FPC_HAS_FEATURE_ANSISTRINGS)}
+procedure do_mkdir(const s: rawbytestring);
 begin
 begin
   InOutRes:=3;
   InOutRes:=3;
 end;
 end;
 
 
-procedure rmdir(s: pchar;len:sizeuint);[IOCheck];
+procedure do_rmdir(const s: rawbytestring);
 begin
 begin
   InOutRes:=3;
   InOutRes:=3;
 end;
 end;
 
 
-procedure chdir(s: pchar;len:sizeuint);[IOCheck];
+procedure do_chdir(const s: rawbytestring);
 begin
 begin
   InOutRes:=3;
   InOutRes:=3;
 end;
 end;
 
 
-{$if defined(FPC_HAS_FEATURE_ANSISTRINGS)}
 procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);
 procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);
+begin
+  InOutRes:=3;
+end;
+
 {$else FPC_HAS_FEATURE_ANSISTRINGS}
 {$else FPC_HAS_FEATURE_ANSISTRINGS}
+
+procedure mkdir(const s: shortstring);
+begin
+  InOutRes:=3;
+end;
+
+procedure rmdir(const s: shortstring);
+begin
+  InOutRes:=3;
+end;
+
+procedure chdir(const s: shortstring);
+begin
+  InOutRes:=3;
+end;
+
 procedure GetDir (DriveNr: byte; var Dir: ShortString);
 procedure GetDir (DriveNr: byte; var Dir: ShortString);
-{$endif FPC_HAS_FEATURE_ANSISTRINGS}
 begin
 begin
   InOutRes:=3;
   InOutRes:=3;
 end;
 end;
+{$endif FPC_HAS_FEATURE_ANSISTRINGS}
 
 
 
 
 
 

+ 30 - 36
rtl/emx/sysdir.inc

@@ -3,7 +3,7 @@
     Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski
     Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski
     member of the Free Pascal development team.
     member of the Free Pascal development team.
 
 
-    FPC Pascal system unit for the Win32 API.
+    FPC Pascal system unit for EMX.
 
 
     See the file COPYING.FPC, included in this distribution,
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
     for details about the copyright.
@@ -19,7 +19,7 @@
                            Directory Handling
                            Directory Handling
 *****************************************************************************}
 *****************************************************************************}
 
 
-procedure DosDir (Func: byte; S: PChar);
+procedure DosDir (Func: byte; S: rawbytestring);
 
 
 begin
 begin
   DoDirSeparators (S);
   DoDirSeparators (S);
@@ -33,17 +33,14 @@ begin
   end ['eax', 'edx'];
   end ['eax', 'edx'];
 end;
 end;
 
 
-procedure MkDir (S: pchar; Len: SizeUInt); [IOCheck, public, alias: 'FPC_SYS_MKDIR'];
+procedure do_MkDir (S: rawbytestring);
 var 
 var 
   RC: cardinal;
   RC: cardinal;
 begin
 begin
-  if not Assigned (S) or (Len = 0) or (InOutRes <> 0) then
-   Exit;
-
   if os_mode = osOs2 then
   if os_mode = osOs2 then
    begin
    begin
     DoDirSeparators (S);
     DoDirSeparators (S);
-    RC := DosCreateDir (S, nil);
+    RC := DosCreateDir (pchar(S), nil);
     if RC <> 0 then
     if RC <> 0 then
      begin
      begin
       InOutRes := RC;
       InOutRes := RC;
@@ -60,49 +57,46 @@ begin
 end;
 end;
 
 
 
 
-procedure RmDir (S: PChar; Len: SizeUInt); [IOCheck, public, alias: 'FPC_SYS_RMDIR'];
+procedure do_RmDir (S: rawbytestring);
 var
 var
   RC: cardinal;
   RC: cardinal;
 begin
 begin
-  if Assigned (S) and (Len <> 0) and (InOutRes = 0) then
-   begin
-    if (Len = 1) and (S^ = '.') then
-     InOutRes := 16
-    else
-     if os_mode = osOs2 then
+  if S = '.' then
+   InOutRes := 16
+  else
+   if os_mode = osOs2 then
+    begin
+     DoDirSeparators (S);
+     RC := DosDeleteDir (pchar(S));
+     if RC <> 0 then
       begin
       begin
-       DoDirSeparators (S);
-       RC := DosDeleteDir (S);
-       if RC <> 0 then
-        begin
-         InOutRes := RC;
-         Errno2InOutRes;
-        end;
-      end
-     else
-     { Under EMX 0.9d DOS this routine call may sometimes fail   }
-     { The syscall documentation indicates clearly that this     }
-     { routine was NOT tested.                                   }
-      DosDir ($3A, S);
-   end
+       InOutRes := RC;
+       Errno2InOutRes;
+      end;
+    end
+   else
+   { Under EMX 0.9d DOS this routine call may sometimes fail   }
+   { The syscall documentation indicates clearly that this     }
+   { routine was NOT tested.                                   }
+    DosDir ($3A, S);
 end;
 end;
 
 
 
 
 {$ASMMODE INTEL}
 {$ASMMODE INTEL}
 
 
-procedure ChDir (S: PChar; Len: SizeUInt); [IOCheck, public, alias: 'FPC_SYS_CHDIR'];
+procedure do_ChDir (S: rawbytestring);
 var
 var
   RC: cardinal;
   RC: cardinal;
+  Len: longint;
 begin
 begin
-  if not Assigned (S) or (Len = 0) or (InOutRes <> 0) then
-    exit;
 (* According to EMX documentation, EMX has only one current directory
 (* According to EMX documentation, EMX has only one current directory
    for all processes, so we'll use native calls under OS/2. *)
    for all processes, so we'll use native calls under OS/2. *)
+  Len := Length (S);
   if os_Mode = osOS2 then
   if os_Mode = osOS2 then
    begin
    begin
-    if (Len >= 2) and (S [1] = ':') then
+    if (Len >= 2) and (S [2] = ':') then
      begin
      begin
-      RC := DosSetDefaultDisk ((Ord (S^) and not ($20)) - $40);
+      RC := DosSetDefaultDisk ((Ord (S[1]) and not ($20)) - $40);
       if RC <> 0 then
       if RC <> 0 then
        begin
        begin
         InOutRes := RC;
         InOutRes := RC;
@@ -112,7 +106,7 @@ begin
        if Len > 2 then
        if Len > 2 then
         begin
         begin
          DoDirSeparators (S);
          DoDirSeparators (S);
-         RC := DosSetCurrentDir (S);
+         RC := DosSetCurrentDir (pchar(S));
          if RC <> 0 then
          if RC <> 0 then
           begin
           begin
            InOutRes := RC;
            InOutRes := RC;
@@ -123,7 +117,7 @@ begin
     else
     else
      begin
      begin
       DoDirSeparators (S);
       DoDirSeparators (S);
-      RC := DosSetCurrentDir (S);
+      RC := DosSetCurrentDir (pchar(S));
       if RC <> 0 then
       if RC <> 0 then
        begin
        begin
         InOutRes:= RC;
         InOutRes:= RC;
@@ -132,7 +126,7 @@ begin
      end;
      end;
    end
    end
   else
   else
-   if (Len >= 2) and (S [1] = ':') then
+   if (Len >= 2) and (S [2] = ':') then
     begin
     begin
      asm
      asm
       mov esi, S
       mov esi, S

+ 3 - 3
rtl/gba/sysdir.inc

@@ -19,17 +19,17 @@
 {*****************************************************************************
 {*****************************************************************************
                            Directory Handling
                            Directory Handling
 *****************************************************************************}
 *****************************************************************************}
-procedure mkdir(s: pchar; len: sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+procedure do_mkdir(const s: rawbytestring);
 begin
 begin
 
 
 end;
 end;
 
 
-procedure rmdir(s: pchar; len: sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+procedure do_rmdir(const s: rawbytestring);
 begin
 begin
 
 
 end;
 end;
 
 
-procedure chdir(s: pchar; len: sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+procedure do_chdir(const s: rawbytestring);
 begin
 begin
 
 
 end;
 end;

+ 23 - 22
rtl/go32v2/sysdir.inc

@@ -3,7 +3,7 @@
     Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski
     Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski
     member of the Free Pascal development team.
     member of the Free Pascal development team.
 
 
-    FPC Pascal system unit for the Win32 API.
+    FPC Pascal system unit for go32v2.
 
 
     See the file COPYING.FPC, included in this distribution,
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
     for details about the copyright.
@@ -18,18 +18,20 @@
                            Directory Handling
                            Directory Handling
 *****************************************************************************}
 *****************************************************************************}
 
 
-procedure DosDir(func:byte;s:pchar;len:integer);
+procedure DosDir(func:byte;s:rawbytestring);
 var
 var
   regs   : trealregs;
   regs   : trealregs;
+  len    : longint;
 begin
 begin
   DoDirSeparators(s);
   DoDirSeparators(s);
   { True DOS does not like backslashes at end
   { True DOS does not like backslashes at end
     Win95 DOS accepts this !!
     Win95 DOS accepts this !!
     but "\" and "c:\" should still be kept and accepted hopefully PM }
     but "\" and "c:\" should still be kept and accepted hopefully PM }
-  if (len>0) and (s[len-1]='\') and
-     Not ((len=1) or ((len=3) and (s[1]=':'))) then
-    s[len-1]:=#0;
-  syscopytodos(longint(s),len+1);
+  len:=length(s);
+  if (len>0) and (s[len]='\') and
+     Not ((len=1) or ((len=3) and (s[2]=':'))) then
+    s[len]:=#0;
+  syscopytodos(longint(pointer(s)),len+1);
   regs.realedx:=tb_offset;
   regs.realedx:=tb_offset;
   regs.realds:=tb_segment;
   regs.realds:=tb_segment;
   if LFNSupport then
   if LFNSupport then
@@ -41,32 +43,31 @@ begin
    GetInOutRes(lo(regs.realeax));
    GetInOutRes(lo(regs.realeax));
 end;
 end;
 
 
-Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+Procedure do_MkDir(const s: rawbytestring);
 begin
 begin
- If not assigned(s) or (len=0) or (InOutRes <> 0) then
-   exit;
-  DosDir($39,s,len);
+  DosDir($39,s);
 end;
 end;
 
 
-Procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+Procedure do_RmDir(const s: rawbytestring);
 begin
 begin
-  if (len=1) and (s[0] = '.' ) then
-    InOutRes := 16;
-  If not assigned(s) or (len=0) or (InOutRes <> 0) then
-   exit;
-  DosDir($3a,s,len);
+  if s='.' then
+    begin
+      InOutRes := 16;
+      exit;
+    end;
+  DosDir($3a,s);
 end;
 end;
 
 
-Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+Procedure do_ChDir(const s: rawbytestring);
 var
 var
   regs : trealregs;
   regs : trealregs;
+  len  : longint;
 begin
 begin
-  If not assigned(s) or (len=0) or (InOutRes <> 0) then
-   exit;
+  len:=length(s);
 { First handle Drive changes }
 { First handle Drive changes }
-  if (len>=2) and (s[1]=':') then
+  if (len>=2) and (s[2]=':') then
    begin
    begin
-     regs.realedx:=(ord(s[0]) and (not 32))-ord('A');
+     regs.realedx:=(ord(s[1]) and (not 32))-ord('A');
      regs.realeax:=$0e00;
      regs.realeax:=$0e00;
      sysrealintr($21,regs);
      sysrealintr($21,regs);
      regs.realeax:=$1900;
      regs.realeax:=$1900;
@@ -82,7 +83,7 @@ begin
        exit;
        exit;
    end;
    end;
 { do the normal dos chdir }
 { do the normal dos chdir }
-  DosDir($3b,s,len);
+  DosDir($3b,s);
 end;
 end;
 
 
 procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);
 procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);

+ 102 - 36
rtl/inc/system.inc

@@ -1501,58 +1501,43 @@ end;
 {$ifdef FPC_HAS_FEATURE_FILEIO}
 {$ifdef FPC_HAS_FEATURE_FILEIO}
 { OS dependent dir functions }
 { OS dependent dir functions }
 {$i sysdir.inc}
 {$i sysdir.inc}
-{$endif FPC_HAS_FEATURE_FILEIO}
-
-{$if defined(FPC_HAS_FEATURE_FILEIO)}
-
 
 
 
 
+{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
 
 
+{$ifndef FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
+procedure do_getdir(drivenr : byte;var dir : rawbytestring);
+var
+  u: unicodestring;
+begin
+  Do_getdir(drivenr,u);
+  widestringmanager.Unicode2AnsiMoveProc(pwidechar(u),dir,DefaultRTLFileSystemCodePage,length(u));
+end;
+{$endif FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
 
 
-Procedure MkDir(Const s: String);
-Var
-  Buffer: Array[0..255] of Char;
+Procedure MkDir(Const s: RawByteString);[IOCheck];
 Begin
 Begin
   If (s='') or (InOutRes <> 0) then
   If (s='') or (InOutRes <> 0) then
    exit;
    exit;
-  Move(s[1], Buffer, Length(s));
-  Buffer[Length(s)] := #0;
-  MkDir(@buffer[0],length(s));
+  Do_mkdir(S);
 End;
 End;
 
 
-Procedure RmDir(Const s: String);
-Var
-  Buffer: Array[0..255] of Char;
+
+Procedure RmDir(Const s: RawByteString);[IOCheck];
 Begin
 Begin
   If (s='') or (InOutRes <> 0) then
   If (s='') or (InOutRes <> 0) then
    exit;
    exit;
-  Move(s[1], Buffer, Length(s));
-  Buffer[Length(s)] := #0;
-  RmDir(@buffer[0],length(s));
+  Do_rmdir(S);
 End;
 End;
 
 
-Procedure ChDir(Const s: String);
-Var
-  Buffer: Array[0..255] of Char;
+
+Procedure ChDir(Const s: RawByteString);[IOCheck];
 Begin
 Begin
   If (s='') or (InOutRes <> 0) then
   If (s='') or (InOutRes <> 0) then
    exit;
    exit;
-  Move(s[1], Buffer, Length(s));
-  Buffer[Length(s)] := #0;
-  ChDir(@buffer[0],length(s));
+  Do_chdir(S);
 End;
 End;
 
 
-{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
-
-{$ifndef FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
-procedure do_getdir(drivenr : byte;var dir : rawbytestring);
-var
-  u: unicodestring;
-begin
-  Do_getdir(drivenr,u);
-  widestringmanager.Unicode2AnsiMoveProc(pwidechar(u),dir,DefaultRTLFileSystemCodePage,length(u));
-end;
-{$endif FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
 
 
 Procedure getdir(drivenr:byte;Var dir:rawbytestring);
 Procedure getdir(drivenr:byte;Var dir:rawbytestring);
 begin
 begin
@@ -1562,9 +1547,47 @@ begin
   setcodepage(dir,DefaultRTLFileSystemCodePage,true);
   setcodepage(dir,DefaultRTLFileSystemCodePage,true);
 end;
 end;
 
 
-{ this one is only implemented elsewhere for systems *not* supporting
-  ansi/unicodestrings; for now assume there are no systems that support
-  unicodestrings but not ansistrings }
+{ the generic shortstring ones are only implemented elsewhere for systems *not*
+  supporting ansi/unicodestrings; for now assume there are no systems that
+  support unicodestrings but not ansistrings }
+
+{ avoid double string conversions }
+{$ifdef FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
+function GetDirStrFromShortstring(const s: shortstring): RawByteString;
+begin
+  GetDirStrFromShortstring:=ToSingleByteFileSystemEncodedFileName(ansistring(s));
+end;
+{$else FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
+function GetDirStrFromShortstring(const s: shortstring): UnicodeString;
+begin
+  GetDirStrFromShortstring:=s;
+end;
+{$endif FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
+
+Procedure MkDir(Const s: shortstring);[IOCheck];
+Begin
+  If (s='') or (InOutRes <> 0) then
+   exit;
+  Do_mkdir(GetDirStrFromShortstring(S));
+End;
+
+
+Procedure RmDir(Const s: shortstring);[IOCheck];
+Begin
+  If (s='') or (InOutRes <> 0) then
+   exit;
+  Do_rmdir(GetDirStrFromShortstring(S));
+End;
+
+
+Procedure ChDir(Const s: shortstring);[IOCheck];
+Begin
+  If (s='') or (InOutRes <> 0) then
+   exit;
+  Do_chdir(GetDirStrFromShortstring(S));
+End;
+
+
 Procedure getdir(drivenr:byte;Var dir:shortstring);
 Procedure getdir(drivenr:byte;Var dir:shortstring);
 var
 var
   s: rawbytestring;
   s: rawbytestring;
@@ -1581,6 +1604,26 @@ end;
 {$if defined(FPC_HAS_FEATURE_WIDESTRINGS)}
 {$if defined(FPC_HAS_FEATURE_WIDESTRINGS)}
 
 
 {$ifndef FPCRTL_FILESYSTEM_TWO_BYTE_API}
 {$ifndef FPCRTL_FILESYSTEM_TWO_BYTE_API}
+{ overloads required for mkdir/rmdir/chdir to ensure that the string is
+  converted to the right code page }
+procedure do_mkdir(const s: unicodestring); {$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+  do_mkdir(ToSingleByteFileSystemEncodedFileName(s));
+end;
+
+
+procedure do_rmdir(const s: unicodestring); {$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+  do_rmdir(ToSingleByteFileSystemEncodedFileName(s));
+end;
+
+
+procedure do_chdir(const s: unicodestring); {$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+  do_chdir(ToSingleByteFileSystemEncodedFileName(s));
+end;
+
+
 procedure do_getdir(drivenr : byte;var dir : unicodestring);
 procedure do_getdir(drivenr : byte;var dir : unicodestring);
 var
 var
   s: rawbytestring;
   s: rawbytestring;
@@ -1590,6 +1633,29 @@ begin
 end;
 end;
 {$endif FPCRTL_FILESYSTEM_TWO_BYTE_API}
 {$endif FPCRTL_FILESYSTEM_TWO_BYTE_API}
 
 
+Procedure MkDir(Const s: UnicodeString);[IOCheck];
+Begin
+  if (s='') or (InOutRes <> 0) then
+   exit;
+  Do_mkdir(S);
+End;
+
+
+Procedure RmDir(Const s: UnicodeString);[IOCheck];
+Begin
+  if (s='') or (InOutRes <> 0) then
+   exit;
+  Do_rmdir(S);
+End;
+
+
+Procedure ChDir(Const s: UnicodeString);[IOCheck];
+Begin
+  if (s='') or (InOutRes <> 0) then
+   exit;
+  Do_chdir(S);
+End;
+
 
 
 Procedure getdir(drivenr:byte;Var dir:unicodestring);
 Procedure getdir(drivenr:byte;Var dir:unicodestring);
 begin
 begin

+ 11 - 6
rtl/inc/systemh.inc

@@ -1178,24 +1178,29 @@ procedure SetTextCodePage(var T: Text; CodePage: TSystemCodePage);
                             Directory Management
                             Directory Management
 ****************************************************************************}
 ****************************************************************************}
 
 
-
 {$ifdef FPC_HAS_FEATURE_FILEIO}
 {$ifdef FPC_HAS_FEATURE_FILEIO}
-Procedure chdir(const s:string); overload;
-Procedure mkdir(const s:string); overload;
-Procedure rmdir(const s:string); overload;
-// the pchar versions are exported via alias for use in objpas
-
+Procedure chdir(const s:shortstring); overload;
+Procedure mkdir(const s:shortstring); overload;
+Procedure rmdir(const s:shortstring); overload;
 Procedure getdir(drivenr:byte;var dir:shortstring);overload;
 Procedure getdir(drivenr:byte;var dir:shortstring);overload;
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
+Procedure chdir(const s:rawbytestring); overload;
+Procedure mkdir(const s:rawbytestring); overload;
+Procedure rmdir(const s:rawbytestring); overload;
 // defaultrtlfilesystemcodepage is returned here
 // defaultrtlfilesystemcodepage is returned here
 Procedure getdir(drivenr:byte;var dir: rawbytestring);overload;{$ifdef FPC_HAS_CPSTRING}rtlproc;{$endif FPC_HAS_CPSTRING}
 Procedure getdir(drivenr:byte;var dir: rawbytestring);overload;{$ifdef FPC_HAS_CPSTRING}rtlproc;{$endif FPC_HAS_CPSTRING}
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+Procedure chdir(const s:unicodestring); overload;
+Procedure mkdir(const s:unicodestring); overload;
+Procedure rmdir(const s:unicodestring); overload;
 Procedure getdir(drivenr:byte;var dir: unicodestring);overload;
 Procedure getdir(drivenr:byte;var dir: unicodestring);overload;
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
 
 
 {$endif FPC_HAS_FEATURE_FILEIO}
 {$endif FPC_HAS_FEATURE_FILEIO}
 
 
+
+
 {*****************************************************************************
 {*****************************************************************************
                              Miscellaneous
                              Miscellaneous
 *****************************************************************************}
 *****************************************************************************}

+ 4 - 12
rtl/macos/sysdir.inc

@@ -18,16 +18,14 @@
                            Directory Handling
                            Directory Handling
 *****************************************************************************}
 *****************************************************************************}
 
 
-procedure mkdir(const s:string);[IOCheck];
+procedure do_mkdir(const s: rawbytestring);
 var
 var
   spec: FSSpec;
   spec: FSSpec;
   createdDirID: Longint;
   createdDirID: Longint;
   err: OSErr;
   err: OSErr;
   res: Integer;
   res: Integer;
 begin
 begin
-  If (s='') or (InOutRes <> 0) then
-    exit;
-
+  { TODO: convert PathArgToFSSpec (and the routines it calls) to rawbytestring }
   res:= PathArgToFSSpec(s, spec);
   res:= PathArgToFSSpec(s, spec);
   if (res = 0) or (res = 2) then
   if (res = 0) or (res = 2) then
     begin
     begin
@@ -38,7 +36,7 @@ begin
     InOutRes:=res;
     InOutRes:=res;
 end;
 end;
 
 
-procedure rmdir(const s:string);[IOCheck];
+procedure do_rmdir(const s: rawbytestring);
 
 
 var
 var
   spec: FSSpec;
   spec: FSSpec;
@@ -46,9 +44,6 @@ var
   res: Integer;
   res: Integer;
 
 
 begin
 begin
-  If (s='') or (InOutRes <> 0) then
-    exit;
-
   res:= PathArgToFSSpec(s, spec);
   res:= PathArgToFSSpec(s, spec);
 
 
   if (res = 0) then
   if (res = 0) then
@@ -65,15 +60,12 @@ begin
     InOutRes:=res;
     InOutRes:=res;
 end;
 end;
 
 
-procedure chdir(const s:string);[IOCheck];
+procedure do_chdir(const s: rawbytestring);
 var
 var
   spec, newDirSpec: FSSpec;
   spec, newDirSpec: FSSpec;
   err: OSErr;
   err: OSErr;
   res: Integer;
   res: Integer;
 begin
 begin
-  if (s='') or (InOutRes <> 0) then
-    exit;
-
   res:= PathArgToFSSpec(s, spec);
   res:= PathArgToFSSpec(s, spec);
   if (res = 0) or (res = 2) then
   if (res = 0) or (res = 2) then
     begin
     begin

+ 17 - 17
rtl/morphos/sysdir.inc

@@ -17,15 +17,14 @@
 {*****************************************************************************
 {*****************************************************************************
                            Directory Handling
                            Directory Handling
 *****************************************************************************}
 *****************************************************************************}
-Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+Procedure do_MkDir(const s: rawbytestring);
 var
 var
-  tmpStr : array[0..255] of char;
+  tmpStr : rawbytestring;
   tmpLock: LongInt;
   tmpLock: LongInt;
 begin
 begin
   checkCTRLC;
   checkCTRLC;
-  if not assigned(s) or (len=0) or (InOutRes<>0) then exit;
-  tmpStr:=PathConv(strpas(s))+#0;
-  tmpLock:=dosCreateDir(@tmpStr);
+  tmpStr:=PathConv(s);
+  tmpLock:=dosCreateDir(pchar(tmpStr));
   if tmpLock=0 then begin
   if tmpLock=0 then begin
     dosError2InOut(IoErr);
     dosError2InOut(IoErr);
     exit;
     exit;
@@ -33,34 +32,35 @@ begin
   UnLock(tmpLock);
   UnLock(tmpLock);
 end;
 end;
 
 
-Procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+Procedure do_RmDir(const s: rawbytestring);
 var
 var
-  tmpStr : array[0..255] of Char;
+  tmpStr : rawbytestring;
 begin
 begin
   checkCTRLC;
   checkCTRLC;
-  if not assigned(s) or (len=0) then exit;
-  if (s='.') then InOutRes:=16;
-  If (s='') or (InOutRes<>0) then exit;
-  tmpStr:=PathConv(strpas(s))+#0;
-  if not dosDeleteFile(@tmpStr) then
+  if (s='.') then
+    begin
+      InOutRes:=16;
+      exit;
+    end;
+  tmpStr:=PathConv(s);
+  if not dosDeleteFile(pchar(tmpStr)) then
     dosError2InOut(IoErr);
     dosError2InOut(IoErr);
 end;
 end;
 
 
-Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+Procedure do_ChDir(const s: rawbytestring);
 var
 var
-  tmpStr : array[0..255] of Char;
+  tmpStr : rawbytestring;
   tmpLock: LongInt;
   tmpLock: LongInt;
   FIB    : PFileInfoBlock;
   FIB    : PFileInfoBlock;
 begin
 begin
   checkCTRLC;
   checkCTRLC;
-  if not assigned(s) or (len=0) or (InOutRes<>0) then exit;
-  tmpStr:=PathConv(strpas(s))+#0;
+  tmpStr:=PathConv(s);
   tmpLock:=0;
   tmpLock:=0;
 
 
   { Changing the directory is a pretty complicated affair }
   { Changing the directory is a pretty complicated affair }
   {   1) Obtain a lock on the directory                   }
   {   1) Obtain a lock on the directory                   }
   {   2) CurrentDir the lock                              }
   {   2) CurrentDir the lock                              }
-  tmpLock:=Lock(@tmpStr,SHARED_LOCK);
+  tmpLock:=Lock(pchar(tmpStr),SHARED_LOCK);
   if tmpLock=0 then begin
   if tmpLock=0 then begin
     dosError2InOut(IoErr);
     dosError2InOut(IoErr);
     exit;
     exit;

+ 22 - 21
rtl/msdos/sysdir.inc

@@ -18,19 +18,21 @@
                            Directory Handling
                            Directory Handling
 *****************************************************************************}
 *****************************************************************************}
 
 
-procedure DosDir(func:byte;s:pchar;len:integer);
+procedure DosDir(func:byte;s: rawbytestring);
 var
 var
   regs   : Registers;
   regs   : Registers;
+  len    : Longint;
 begin
 begin
   DoDirSeparators(s);
   DoDirSeparators(s);
   { True DOS does not like backslashes at end
   { True DOS does not like backslashes at end
     Win95 DOS accepts this !!
     Win95 DOS accepts this !!
     but "\" and "c:\" should still be kept and accepted hopefully PM }
     but "\" and "c:\" should still be kept and accepted hopefully PM }
-  if (len>0) and (s[len-1]='\') and
-     Not ((len=1) or ((len=3) and (s[1]=':'))) then
-    s[len-1]:=#0;
-  regs.DX:=Ofs(s^);
-  regs.DS:=Seg(s^);
+  len:=length(s);
+  if (len>0) and (s[len]='\') and
+     Not ((len=1) or ((len=3) and (s[2]=':'))) then
+    s[len]:=#0;
+  regs.DX:=Ofs(s[1]);
+  regs.DS:=Seg(s[1]);
   if LFNSupport then
   if LFNSupport then
    regs.AX:=$7100+func
    regs.AX:=$7100+func
   else
   else
@@ -40,32 +42,31 @@ begin
    GetInOutRes(regs.AX);
    GetInOutRes(regs.AX);
 end;
 end;
 
 
-Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+Procedure do_MkDir(const s: rawbytestring);
 begin
 begin
-  If not assigned(s) or (len=0) or (InOutRes <> 0) then
-    exit;
-   DosDir($39,s,len);
+   DosDir($39,s);
 end;
 end;
 
 
-Procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+Procedure do_RmDir(const s: rawbytestring);
 begin
 begin
-  if (len=1) and (s[0] = '.' ) then
-    InOutRes := 16;
-  If not assigned(s) or (len=0) or (InOutRes <> 0) then
-   exit;
-  DosDir($3a,s,len);
+  if s='.' then
+    begin
+      InOutRes:=16;
+      exit;
+    end;
+  DosDir($3a,s);
 end;
 end;
 
 
-Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+Procedure do_ChDir(const s: rawbytestring);
 var
 var
   regs : Registers;
   regs : Registers;
+  len  : Longint;
 begin
 begin
-  If not assigned(s) or (len=0) or (InOutRes <> 0) then
-   exit;
+  len:=Length(s);
 { First handle Drive changes }
 { First handle Drive changes }
-  if (len>=2) and (s[1]=':') then
+  if (len>=2) and (s[2]=':') then
    begin
    begin
-     regs.DX:=(ord(s[0]) and (not 32))-ord('A');
+     regs.DX:=(ord(s[1]) and (not 32))-ord('A');
      regs.AX:=$0e00;
      regs.AX:=$0e00;
      MsDos(regs);
      MsDos(regs);
      regs.AX:=$1900;
      regs.AX:=$1900;

+ 15 - 14
rtl/nativent/sysdir.inc

@@ -17,7 +17,7 @@
                            Directory Handling
                            Directory Handling
 *****************************************************************************}
 *****************************************************************************}
 
 
-procedure MkDir(s: pchar; len: sizeuint); [IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+procedure do_MkDir(const s: UnicodeString);
 var
 var
   objattr: TObjectAttributes;
   objattr: TObjectAttributes;
   name: TNtUnicodeString;
   name: TNtUnicodeString;
@@ -25,10 +25,7 @@ var
   iostatus: TIOStatusBlock;
   iostatus: TIOStatusBlock;
   h: THandle;
   h: THandle;
 begin
 begin
-  if not Assigned(s) or (len <= 1) or (InOutRes <> 0) then
-    Exit;
-
-  SysPCharToNtStr(name, s, len);
+  SysUnicodeStringToNtStr(name, s);
 
 
   { first we try to create a directory object }
   { first we try to create a directory object }
   SysInitializeObjectAttributes(objattr, @name, OBJ_PERMANENT, 0, Nil);
   SysInitializeObjectAttributes(objattr, @name, OBJ_PERMANENT, 0, Nil);
@@ -61,7 +58,7 @@ begin
   SysFreeNtStr(name);
   SysFreeNtStr(name);
 end;
 end;
 
 
-procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+procedure do_RmDir(const s: UnicodeString);
 var
 var
   ntstr: TNtUnicodeString;
   ntstr: TNtUnicodeString;
   objattr: TObjectAttributes;
   objattr: TObjectAttributes;
@@ -70,14 +67,18 @@ var
   disp: TFileDispositionInformation;
   disp: TFileDispositionInformation;
   res: LongInt;
   res: LongInt;
 begin
 begin
-  if (len = 1) and (s^ = '.') then
-    InOutRes := 16;
-  if not assigned(s) or (len = 0) or (InOutRes <> 0) then
-    Exit;
-  if (len = 2) and (s[0] = '.') and (s[1] = '.') then
-    InOutRes := 5;
+  if s = '.' then
+    begin
+      InOutRes := 16;
+      exit;
+    end;
+  if s = '..' then
+    begin
+      InOutRes := 5;
+      exit;
+    end;
 
 
-  SysPCharToNtStr(ntstr, s, len);
+  SysUnicodeStringToNtStr(ntstr, s);
   SysInitializeObjectAttributes(objattr, @ntstr, 0, 0, Nil);
   SysInitializeObjectAttributes(objattr, @ntstr, 0, 0, Nil);
 
 
   res := NtOpenDirectoryObject(@h, STANDARD_RIGHTS_REQUIRED, @objattr);
   res := NtOpenDirectoryObject(@h, STANDARD_RIGHTS_REQUIRED, @objattr);
@@ -115,7 +116,7 @@ begin
   Errno2InoutRes;
   Errno2InoutRes;
 end;
 end;
 
 
-procedure ChDir(s: pchar; len: sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+procedure do_ChDir(const s: UnicodeString);
 begin
 begin
   { for now this is not supported }
   { for now this is not supported }
   InOutRes := 3;
   InOutRes := 3;

+ 3 - 6
rtl/nds/sysdir.inc

@@ -19,21 +19,18 @@
 {*****************************************************************************
 {*****************************************************************************
                            Directory Handling
                            Directory Handling
 *****************************************************************************}
 *****************************************************************************}
-procedure mkdir(s: pchar; len: sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+procedure do_mkdir(const s: rawbytestring);
 begin
 begin
-  if not assigned(s) or (len=0) or (InOutRes<>0) then exit;
 
 
 end;
 end;
 
 
-procedure rmdir(s: pchar; len: sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+procedure do_rmdir(const s: rawbytestring);
 begin
 begin
-  if not assigned(s) or (len=0) then exit;
 
 
 end;
 end;
 
 
-procedure chdir(s: pchar; len: sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+procedure do_chdir(const s: rawbytestring);
 begin
 begin
-  if not assigned(s) or (len=0) then exit;
 
 
 end;
 end;
 
 

+ 10 - 11
rtl/netware/sysdir.inc

@@ -17,12 +17,10 @@
                            Directory Handling
                            Directory Handling
 *****************************************************************************}
 *****************************************************************************}
 
 
-Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+Procedure do_MkDir(s: rawbytestring);
 var
 var
     Rc : longint;
     Rc : longint;
 begin
 begin
-  If not assigned(s) or (len=0) or (InOutRes <> 0) then
-    exit;
   DoDirSeparators(s);
   DoDirSeparators(s);
   Rc := _mkdir(pchar(s));
   Rc := _mkdir(pchar(s));
   if Rc <> 0 then
   if Rc <> 0 then
@@ -30,13 +28,14 @@ begin
 end;
 end;
 
 
 
 
-procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+procedure do_RmDir(s: rawbytestring);
 var Rc : longint;
 var Rc : longint;
 begin
 begin
-  if (len=1) and (s^ = '.' ) then
-    InOutRes := 16;
-  If not assigned(s) or (len=0) or (InOutRes <> 0) then
-    exit;
+  if s = '.' then
+    begin
+      InOutRes := 16;
+      exit;
+    end;
   DoDirSeparators(s);
   DoDirSeparators(s);
   Rc := _rmdir(pchar(s));
   Rc := _rmdir(pchar(s));
   if Rc <> 0 then
   if Rc <> 0 then
@@ -44,16 +43,16 @@ begin
 end;
 end;
 
 
 
 
-procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+procedure do_ChDir(s: rawbytestring);
 var RC: longint;
 var RC: longint;
 begin
 begin
-  If not assigned(s) or (len=0) or (InOutRes <> 0) then
-    exit;
+  DoDirSeparators(s);
   RC := _chdir (pchar(s));
   RC := _chdir (pchar(s));
   if Rc <> 0 then
   if Rc <> 0 then
     SetFileError(Rc);
     SetFileError(Rc);
 end;
 end;
 
 
+
 procedure do_getdir(drivenr : byte;var dir : rawbytestring);
 procedure do_getdir(drivenr : byte;var dir : rawbytestring);
 VAR P : ARRAY [0..255] OF CHAR;
 VAR P : ARRAY [0..255] OF CHAR;
     i : LONGINT;
     i : LONGINT;

+ 6 - 5
rtl/netwlibc/sysdir.inc

@@ -17,20 +17,20 @@
 {*****************************************************************************
 {*****************************************************************************
                            Directory Handling
                            Directory Handling
 *****************************************************************************}
 *****************************************************************************}
-Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+Procedure do_MkDir(const s: rawbytestring);
 var Res: LONGINT;
 var Res: LONGINT;
 BEGIN
 BEGIN
-  Res := FpMkdir (s,S_IRWXU);
+  Res := FpMkdir (pchar(s),S_IRWXU);
   if Res = 0 then
   if Res = 0 then
     InOutRes:=0
     InOutRes:=0
   else
   else
     SetFileError (Res);
     SetFileError (Res);
 end;
 end;
 
 
-procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+procedure do_RmDir(const s: rawbytestring);
 var Res: longint;
 var Res: longint;
 begin
 begin
-  Res := FpRmdir (s);
+  Res := FpRmdir (pchar(s));
   if Res = 0 then
   if Res = 0 then
     InOutRes:=0
     InOutRes:=0
   else
   else
@@ -38,7 +38,7 @@ begin
 end;
 end;
 
 
 
 
-procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+procedure do_ChDir(const s: rawbytestring);
 var Res: longint;
 var Res: longint;
 begin
 begin
   Res := FpChdir (s);
   Res := FpChdir (s);
@@ -48,6 +48,7 @@ begin
     SetFileError (Res);
     SetFileError (Res);
 end;
 end;
 
 
+
 procedure do_getdir(drivenr : byte;var dir : rawbytestring);
 procedure do_getdir(drivenr : byte;var dir : rawbytestring);
 var P : array [0..255] of CHAR;
 var P : array [0..255] of CHAR;
     i : LONGINT;
     i : LONGINT;

+ 0 - 33
rtl/objpas/objpas.pp

@@ -87,12 +87,6 @@ Var
      Function ParamStr(Param : Integer) : Ansistring;
      Function ParamStr(Param : Integer) : Ansistring;
 {$endif FPC_HAS_FEATURE_COMMANDARGS}
 {$endif FPC_HAS_FEATURE_COMMANDARGS}
 
 
-{$if defined(FPC_HAS_FEATURE_FILEIO) and defined(FPC_HAS_FEATURE_ANSISTRINGS)}
-     Procedure MkDir(s:ansistring);overload;
-     Procedure RmDir(s:ansistring);overload;
-     Procedure ChDir(s:ansistring);overload;
-{$endif defined(FPC_HAS_FEATURE_FILEIO) and defined(FPC_HAS_FEATURE_ANSISTRINGS)}
-
 {****************************************************************************
 {****************************************************************************
                              Resource strings.
                              Resource strings.
 ****************************************************************************}
 ****************************************************************************}
@@ -130,9 +124,6 @@ Var
 ****************************************************************************}
 ****************************************************************************}
 
 
 {$ifdef FPC_HAS_FEATURE_FILEIO}
 {$ifdef FPC_HAS_FEATURE_FILEIO}
-Procedure MkDirpchar(s: pchar;len:sizeuint);[IOCheck]; external name 'FPC_SYS_MKDIR';
-Procedure ChDirpchar(s: pchar;len:sizeuint);[IOCheck]; external name 'FPC_SYS_CHDIR';
-Procedure RmDirpchar(s: pchar;len:sizeuint);[IOCheck]; external name 'FPC_SYS_RMDIR';
 
 
 { Untyped file support }
 { Untyped file support }
 
 
@@ -233,30 +224,6 @@ Function ParamStr(Param : Integer) : ansistring;
   end;
   end;
 {$endif FPC_HAS_FEATURE_COMMANDARGS}
 {$endif FPC_HAS_FEATURE_COMMANDARGS}
 
 
-
-{$if defined(FPC_HAS_FEATURE_FILEIO) and defined(FPC_HAS_FEATURE_ANSISTRINGS)}
-{ xxDirPChar procedures can adjust directory separators in supplied string (at least
-  Windows implementation does so). Therefore full copy of argument is needed,
-  just passing by value isn't enough because it won't copy a string literal. }
-Procedure MkDir(s:ansistring);[IOCheck];
-begin
-  UniqueString(s);
-  mkdirpchar(pchar(s),length(s));
-end;
-
-Procedure RmDir(s:ansistring);[IOCheck];
-begin
-  UniqueString(s);
-  RmDirpchar(pchar(s),length(s));
-end;
-
-Procedure ChDir(s:ansistring);[IOCheck];
-begin
-  UniqueString(s);
-  ChDirpchar(pchar(s),length(s));
-end;
-{$endif defined(FPC_HAS_FEATURE_FILEIO) and defined(FPC_HAS_FEATURE_ANSISTRINGS)}
-
 {$ifdef FPC_HAS_FEATURE_RESOURCES}
 {$ifdef FPC_HAS_FEATURE_RESOURCES}
 { ---------------------------------------------------------------------
 { ---------------------------------------------------------------------
     ResourceString support
     ResourceString support

+ 16 - 17
rtl/os2/sysdir.inc

@@ -19,14 +19,12 @@
                            Directory Handling
                            Directory Handling
 *****************************************************************************}
 *****************************************************************************}
 
 
-Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+Procedure do_MkDir(s: rawbytestring);
 var 
 var 
     Rc : word;
     Rc : word;
 begin
 begin
-  If not assigned(s) or (len=0) or (InOutRes <> 0) then
-    exit;
   DoDirSeparators(s);
   DoDirSeparators(s);
-  Rc := DosCreateDir(s,nil);
+  Rc := DosCreateDir(pchar(s),nil);
   if Rc <> 0 then
   if Rc <> 0 then
     begin
     begin
       InOutRes := Rc;
       InOutRes := Rc;
@@ -34,16 +32,17 @@ begin
     end;
     end;
 end;
 end;
 
 
-Procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+Procedure do_RmDir(s: rawbytestring);
 var 
 var 
     Rc : word;
     Rc : word;
 begin
 begin
-  if (len=1) and (s^ = '.' ) then
-    InOutRes := 16;
-  If not assigned(s) or (len=0) or (InOutRes <> 0) then
-    exit;
+  if s = '.' then
+    begin
+      InOutRes := 16;
+      exit;
+    end;
   DoDirSeparators(s);
   DoDirSeparators(s);
-  Rc := DosDeleteDir(s);
+  Rc := DosDeleteDir(pchar(s));
   if Rc <> 0 then
   if Rc <> 0 then
     begin
     begin
       InOutRes := Rc;
       InOutRes := Rc;
@@ -53,23 +52,23 @@ end;
 
 
 {$ASMMODE INTEL}
 {$ASMMODE INTEL}
 
 
-Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+Procedure do_ChDir(s: rawbytestring);
 
 
 var RC: cardinal;
 var RC: cardinal;
+    Len: Longint;
 
 
 begin
 begin
-  If not assigned(s) or (len=0) or (InOutRes <> 0) then
-    exit;
-  if (Len >= 2) and (S[1] = ':') then
+  Len := Length (s);
+  if (Len >= 2) and (S[2] = ':') then
   begin
   begin
-    RC := DosSetDefaultDisk ((Ord (S [0]) and not ($20)) - $40);
+    RC := DosSetDefaultDisk ((Ord (S [1]) and not ($20)) - $40);
     if RC <> 0 then
     if RC <> 0 then
       InOutRes := RC
       InOutRes := RC
     else
     else
       if Len > 2 then
       if Len > 2 then
       begin
       begin
         DoDirSeparators (s);
         DoDirSeparators (s);
-        RC := DosSetCurrentDir (s);
+        RC := DosSetCurrentDir (pchar (s));
         if RC <> 0 then
         if RC <> 0 then
         begin
         begin
           InOutRes := RC;
           InOutRes := RC;
@@ -78,7 +77,7 @@ begin
       end;
       end;
   end else begin
   end else begin
     DoDirSeparators (s);
     DoDirSeparators (s);
-    RC := DosSetCurrentDir (s);
+    RC := DosSetCurrentDir (pchar (s));
     if RC <> 0 then
     if RC <> 0 then
     begin
     begin
       InOutRes:= RC;
       InOutRes:= RC;

+ 3 - 3
rtl/symbian/sysdir.inc

@@ -17,17 +17,17 @@
                            Directory Handling
                            Directory Handling
 *****************************************************************************}
 *****************************************************************************}
 
 
-procedure mkdir(const s:string);[IOCHECK];
+procedure do_mkdir(const s:rawbytestring);
 begin
 begin
 
 
 end;
 end;
 
 
-procedure rmdir(const s:string);[IOCHECK];
+procedure do_rmdir(const s:rawbytestring);
 begin
 begin
 
 
 end;
 end;
 
 
-procedure chdir(const s:string);[IOCHECK];
+procedure do_chdir(const s:rawbytestring);
 begin
 begin
 
 
 end;
 end;

+ 17 - 25
rtl/unix/sysdir.inc

@@ -18,7 +18,6 @@
                            Directory Handling
                            Directory Handling
 *****************************************************************************}
 *****************************************************************************}
 
 
-Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
 const
 const
   { read/write search permission for everyone }
   { read/write search permission for everyone }
   MODE_MKDIR = S_IWUSR OR S_IRUSR OR
   MODE_MKDIR = S_IWUSR OR S_IRUSR OR
@@ -26,39 +25,32 @@ const
                S_IWOTH OR S_IROTH OR
                S_IWOTH OR S_IROTH OR
                S_IXUSR OR S_IXGRP OR S_IXOTH;
                S_IXUSR OR S_IXGRP OR S_IXOTH;
 
 
-// len is not passed to the *nix functions because the unix API doesn't 
-// use length safeguards for these functions. (probably because there
-// already is a length limit due to PATH_MAX)
+Procedure Do_MkDir(s: rawbytestring);
 
 
 Begin
 Begin
-  If not assigned(s) or (len=0) or (InOutRes <> 0) then
-    exit;
-  If Fpmkdir(s, MODE_MKDIR)<0 Then
+  If Fpmkdir(pchar(s), MODE_MKDIR)<0 Then
    Errno2Inoutres
    Errno2Inoutres
-  Else
-   InOutRes:=0;
 End;
 End;
 
 
-Procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
-Begin
-  if (len=1) and (s^ = '.') then
-    InOutRes := 16;
-  If not assigned(s) or (len=0) or (InOutRes <> 0) then
-    exit;
-  If Fprmdir(s)<0 Then
+
+Procedure Do_RmDir(s: rawbytestring);
+
+begin
+  if (s='.') then
+    begin
+      InOutRes := 16;
+      exit;
+    end;
+  If Fprmdir(pchar(S))<0 Then
    Errno2Inoutres
    Errno2Inoutres
-  Else
-   InOutRes:=0;
 End;
 End;
 
 
-Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+
+Procedure do_ChDir(s: rawbytestring);
+
 Begin
 Begin
-  If not assigned(s) or (len=0) or (InOutRes <> 0) then
-   exit;
-  If Fpchdir(s)<0 Then
-   Errno2Inoutres
-  Else
-   InOutRes:=0;
+  If Fpchdir(pchar(s))<0 Then
+   Errno2Inoutres;
   { file not exists is path not found under tp7 }
   { file not exists is path not found under tp7 }
   if InOutRes=2 then
   if InOutRes=2 then
    InOutRes:=3;
    InOutRes:=3;

+ 14 - 12
rtl/watcom/sysdir.inc

@@ -2,11 +2,16 @@
                            Directory Handling
                            Directory Handling
 *****************************************************************************}
 *****************************************************************************}
 
 
-procedure DosDir(func:byte;const s:string);
+procedure DosDir(func:byte;const s:rawbytestring);
 var
 var
   buffer : array[0..255] of char;
   buffer : array[0..255] of char;
   regs   : trealregs;
   regs   : trealregs;
 begin
 begin
+  if length(s)>255 then
+    begin
+      inoutres:=3;
+      exit;
+    end;
   move(s[1],buffer,length(s));
   move(s[1],buffer,length(s));
   buffer[length(s)]:=#0;
   buffer[length(s)]:=#0;
   DoDirSeparators(pchar(@buffer));
   DoDirSeparators(pchar(@buffer));
@@ -29,30 +34,27 @@ begin
 end;
 end;
 
 
 
 
-procedure mkdir(const s : string);[IOCheck];
+procedure do_mkdir(const s : rawbytestring);
 begin
 begin
-  If (s='') or (InOutRes <> 0) then
-   exit;
   DosDir($39,s);
   DosDir($39,s);
 end;
 end;
 
 
 
 
-procedure rmdir(const s : string);[IOCheck];
+procedure do_rmdir(const s : rawbytestring);
 begin
 begin
-  if (s = '.' ) then
-    InOutRes := 16;
-  If (s='') or (InOutRes <> 0) then
-   exit;
+  if s = '.' then
+    begin
+      InOutRes := 16;
+      exit;
+    end;
   DosDir($3a,s);
   DosDir($3a,s);
 end;
 end;
 
 
 
 
-procedure chdir(const s : string);[IOCheck];
+procedure do_chdir(const s : rawbytestring);
 var
 var
   regs : trealregs;
   regs : trealregs;
 begin
 begin
-  If (s='') or (InOutRes <> 0) then
-   exit;
 { First handle Drive changes }
 { First handle Drive changes }
   if (length(s)>=2) and (s[2]=':') then
   if (length(s)>=2) and (s[2]=':') then
    begin
    begin

+ 10 - 10
rtl/wii/sysdir.inc

@@ -18,28 +18,28 @@
 {*****************************************************************************
 {*****************************************************************************
                            Directory Handling
                            Directory Handling
 *****************************************************************************}
 *****************************************************************************}
-procedure mkdir(s: pchar; len: sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+procedure do_mkdir(const s: rawbytestring);
 begin
 begin
-  if not assigned(s) or (len=0) or (InOutRes<>0) then exit;
+  { TODO: convert callback to use rawbytestring to avoid conversion }
   if FileIODevice.DirIO.DoMkdir <> nil then
   if FileIODevice.DirIO.DoMkdir <> nil then
-    FileIODevice.DirIO.DoMkdir(strpas(s));
+    FileIODevice.DirIO.DoMkdir(s);
 end;
 end;
 
 
-procedure rmdir(s: pchar; len: sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+procedure do_rmdir(const s: rawbytestring);
 begin
 begin
-  if not assigned(s) or (len=0) then exit;
+  { TODO: convert callback to use rawbytestring to avoid conversion }
   if FileIODevice.DirIO.DoRmdir <> nil then
   if FileIODevice.DirIO.DoRmdir <> nil then
-    FileIODevice.DirIO.DoRmdir(strpas(s));
+    FileIODevice.DirIO.DoRmdir(s);
 end;
 end;
 
 
-procedure chdir(s: pchar; len: sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+procedure do_chdir(const s: rawbytestring);
 begin
 begin
-  if not assigned(s) or (len=0) then exit;
+  { TODO: convert callback to use rawbytestring to avoid conversion }
   if FileIODevice.DirIO.DoChdir <> nil then
   if FileIODevice.DirIO.DoChdir <> nil then
-    FileIODevice.DirIO.DoChdir(strpas(s));
+    FileIODevice.DirIO.DoChdir(pchar(s));
 end;
 end;
 
 
-procedure GetDir(DriveNr: byte; var Dir: RawByteString);
+procedure do_GetDir(DriveNr: byte; var Dir: RawByteString);
 var
 var
   TmpDir: ShortString;
   TmpDir: ShortString;
 begin
 begin

+ 25 - 28
rtl/win/sysdir.inc

@@ -20,53 +20,50 @@
 type
 type
  TDirFnType=function(name:pointer):longbool;stdcall;
  TDirFnType=function(name:pointer):longbool;stdcall;
 
 
-procedure dirfn(afunc : TDirFnType;s:pchar;len:integer);
+function CreateDirectoryTrunc(name:pointer):longbool;stdcall;
+begin
+  CreateDirectoryTrunc:=CreateDirectoryW(name,nil);
+end;
+
+procedure dirfn(afunc : TDirFnType;s:unicodestring);
 begin
 begin
   DoDirSeparators(s);
   DoDirSeparators(s);
-  if not aFunc(s) then
+  if not aFunc(punicodechar(s)) then
     begin
     begin
       errno:=GetLastError;
       errno:=GetLastError;
       Errno2InoutRes;
       Errno2InoutRes;
     end;
     end;
 end;
 end;
-
-function CreateDirectoryTrunc(name:pointer):longbool;stdcall;
+Procedure do_MkDir(const s: UnicodeString);
 begin
 begin
-  CreateDirectoryTrunc:=CreateDirectory(name,nil);
+  dirfn(TDirFnType(@CreateDirectoryTrunc),s);
 end;
 end;
 
 
-Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+Procedure do_RmDir(const s: UnicodeString);
 begin
 begin
-  If not assigned(s) or (len=0) or (InOutRes <> 0) then
-   exit;
-  dirfn(TDirFnType(@CreateDirectoryTrunc),s,len);
-end;
-
-Procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
-
-begin
-  if (len=1) and (s^ ='.') then
-    InOutRes := 16;
-  If not assigned(s) or (len=0) or (InOutRes <> 0) then
-   exit;
-{$ifdef WINCE}
-  if (len=2) and (s[0]='.') and (s[1]='.') then
-    InOutRes := 5;
-{$endif WINCE}
-  dirfn(TDirFnType(@RemoveDirectory),s,len);
+  if (s ='.') then
+    begin
+      InOutRes := 16;
+      exit;
+    end;
+  {$ifdef WINCE}
+  if (s='..') then
+    begin
+      InOutRes := 5;
+      exit;
+    end;
+  {$endif WINCE}
+  dirfn(TDirFnType(@RemoveDirectoryW),s);
 {$ifdef WINCE}
 {$ifdef WINCE}
   if (Inoutres=3) and (Pos(DirectorySeparator, s)<2) then
   if (Inoutres=3) and (Pos(DirectorySeparator, s)<2) then
     Inoutres:=2;
     Inoutres:=2;
 {$endif WINCE}
 {$endif WINCE}
 end;
 end;
 
 
-Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
-
+Procedure do_ChDir(const s: UnicodeString);
 begin
 begin
 {$ifndef WINCE}
 {$ifndef WINCE}
-  If not assigned(s) or (len=0) or (InOutRes <> 0) then
-   exit;
-  dirfn(TDirFnType(@SetCurrentDirectory),s,len);
+  dirfn(TDirFnType(@SetCurrentDirectoryW),s);
   if Inoutres=2 then
   if Inoutres=2 then
    Inoutres:=3;
    Inoutres:=3;
 {$else WINCE}
 {$else WINCE}

+ 4 - 15
rtl/win/sysos.inc

@@ -291,13 +291,6 @@ threadvar
                        lpSecurityAttributes:PSECURITYATTRIBUTES; dwCreationDisposition:DWORD;
                        lpSecurityAttributes:PSECURITYATTRIBUTES; dwCreationDisposition:DWORD;
                        dwFlagsAndAttributes:DWORD; hTemplateFile:DWORD):THandle;
                        dwFlagsAndAttributes:DWORD; hTemplateFile:DWORD):THandle;
      stdcall;external KernelDLL name 'CreateFileW';
      stdcall;external KernelDLL name 'CreateFileW';
-   { Directory }
-   function CreateDirectory(name : pointer;sec : pointer) : longbool;
-     stdcall;external KernelDLL name 'CreateDirectoryW';
-   function RemoveDirectory(name:pointer):longbool;
-     stdcall;external KernelDLL name 'RemoveDirectoryW';
-   function SetCurrentDirectory(name : pointer) : longbool;
-     stdcall;external KernelDLL name 'SetCurrentDirectoryW';
    {$else}
    {$else}
    function GetFileAttributes(p : pchar) : dword;
    function GetFileAttributes(p : pchar) : dword;
      stdcall;external KernelDLL name 'GetFileAttributesA';
      stdcall;external KernelDLL name 'GetFileAttributesA';
@@ -309,16 +302,12 @@ threadvar
                        lpSecurityAttributes:PSECURITYATTRIBUTES; dwCreationDisposition:DWORD;
                        lpSecurityAttributes:PSECURITYATTRIBUTES; dwCreationDisposition:DWORD;
                        dwFlagsAndAttributes:DWORD; hTemplateFile:DWORD):THandle;
                        dwFlagsAndAttributes:DWORD; hTemplateFile:DWORD):THandle;
      stdcall;external KernelDLL name 'CreateFileA';
      stdcall;external KernelDLL name 'CreateFileA';
-   { Directory }
-   function CreateDirectory(name : pointer;sec : pointer) : longbool;
-     stdcall;external KernelDLL name 'CreateDirectoryA';
-   function RemoveDirectory(name:pointer):longbool;
-     stdcall;external KernelDLL name 'RemoveDirectoryA';
-   function SetCurrentDirectory(name : pointer) : longbool;
-     stdcall;external KernelDLL name 'SetCurrentDirectoryA';
-
   {$endif}
   {$endif}
    { Directory }
    { Directory }
+   function CreateDirectoryW(name : pointer;sec : pointer) : longbool;
+     stdcall;external KernelDLL name 'CreateDirectoryW';
+   function RemoveDirectoryW(name:pointer):longbool;
+     stdcall;external KernelDLL name 'RemoveDirectoryW';
    function SetCurrentDirectoryW(name : pointer) : longbool;
    function SetCurrentDirectoryW(name : pointer) : longbool;
      stdcall;external KernelDLL name 'SetCurrentDirectoryW';
      stdcall;external KernelDLL name 'SetCurrentDirectoryW';
    function GetCurrentDirectoryW(bufsize : longint;name : punicodechar) : Dword;
    function GetCurrentDirectoryW(bufsize : longint;name : punicodechar) : Dword;

+ 6 - 23
rtl/wince/system.pp

@@ -94,9 +94,6 @@ function CreateFile(lpFileName:pchar; dwDesiredAccess:DWORD; dwShareMode:DWORD;
                    lpSecurityAttributes:pointer; dwCreationDisposition:DWORD;
                    lpSecurityAttributes:pointer; dwCreationDisposition:DWORD;
                    dwFlagsAndAttributes:DWORD; hTemplateFile:DWORD):longint;
                    dwFlagsAndAttributes:DWORD; hTemplateFile:DWORD):longint;
 
 
-function CreateDirectory(name : pointer;sec : pointer) : longbool;
-function RemoveDirectory(name:pointer):longbool;
-
 
 
 {$ifdef CPUARM}
 {$ifdef CPUARM}
 { the external directive isn't really necessary here because it is overridden by external (FK) }
 { the external directive isn't really necessary here because it is overridden by external (FK) }
@@ -206,6 +203,12 @@ var
 function MessageBox(w1:longint;l1,l2:PWideChar;w2:longint):longint;
 function MessageBox(w1:longint;l1,l2:PWideChar;w2:longint):longint;
    cdecl; external 'coredll' name 'MessageBoxW';
    cdecl; external 'coredll' name 'MessageBoxW';
 
 
+function CreateDirectoryW(name : pwidechar;sec : pointer) : longbool;
+    cdecl; external KernelDLL name 'CreateDirectoryW';
+function RemoveDirectoryW(name:pwidechar):longbool;
+    cdecl; external KernelDLL name 'RemoveDirectoryW';
+
+
 {*****************************************************************************}
 {*****************************************************************************}
 
 
 {$define FPC_SYSTEM_HAS_MOVE}
 {$define FPC_SYSTEM_HAS_MOVE}
@@ -424,10 +427,6 @@ function CreateFileW(lpFileName:pwidechar; dwDesiredAccess:DWORD; dwShareMode:DW
                    lpSecurityAttributes:pointer; dwCreationDisposition:DWORD;
                    lpSecurityAttributes:pointer; dwCreationDisposition:DWORD;
                    dwFlagsAndAttributes:DWORD; hTemplateFile:DWORD):longint;
                    dwFlagsAndAttributes:DWORD; hTemplateFile:DWORD):longint;
     cdecl; external KernelDLL name 'CreateFileW';
     cdecl; external KernelDLL name 'CreateFileW';
-function CreateDirectoryW(name : pwidechar;sec : pointer) : longbool;
-    cdecl; external KernelDLL name 'CreateDirectoryW';
-function RemoveDirectoryW(name:pwidechar):longbool;
-    cdecl; external KernelDLL name 'RemoveDirectoryW';
 
 
 function GetFileAttributes(p : pchar) : dword;
 function GetFileAttributes(p : pchar) : dword;
 var
 var
@@ -465,22 +464,6 @@ begin
                             dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile);
                             dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile);
 end;
 end;
 
 
-function CreateDirectory(name : pointer;sec : pointer) : longbool;
-var
-  buf: array[0..MaxPathLen] of WideChar;
-begin
-  AnsiToWideBuf(name, -1, buf, SizeOf(buf));
-  CreateDirectory := CreateDirectoryW(buf, sec);
-end;
-
-function RemoveDirectory(name:pointer):longbool;
-var
-  buf: array[0..MaxPathLen] of WideChar;
-begin
-  AnsiToWideBuf(name, -1, buf, SizeOf(buf));
-  RemoveDirectory := RemoveDirectoryW(buf);
-end;
-
 const
 const
 {$ifdef CPUARM}
 {$ifdef CPUARM}
   UserKData = $FFFFC800;
   UserKData = $FFFFC800;

+ 135 - 0
tests/test/units/system/tdir2.pp

@@ -0,0 +1,135 @@
+{ Program to test OS-specific features of the system unit }
+{ routines to test:                                       }
+{   mkdir()                                               }
+{   chdir()                                               }
+{   rmdir()                                               }
+{   getdir()                                              }
+{ This program tests support for non-ASCII chaaracters in }
+{ path names                                              }
+
+{ %target=win32,win64,darwin,freebsd,openbsd,netbsd,linux,morphos,haiku,aix,nativent }
+
+Program tdir;
+{$codepage utf-8}
+{$I-}
+
+{$ifdef unix}
+uses
+  cwstring;
+{$endif}
+
+procedure test(value, required: longint);
+begin
+  if value <> required then
+    begin
+      writeln('Got ',value,' instead of ',required);
+      halt(1);
+    end;
+end;
+
+
+procedure testansi;
+const
+  dirname: utf8string = '鿆®';
+var
+  orgdir, newdir: rawbytestring;
+Begin
+   Writeln('rawbytestring tests');
+   Write('Getting current directory...');
+   getdir(0,orgdir);
+   test(IOResult,0);
+   WriteLn('Passed');
+   
+   Write('creating new directory...');
+   mkdir(dirname);
+   test(IOResult,0);
+   WriteLn('Passed');
+
+   Write('changing to new directory...');
+   chdir(dirname);
+   test(IOResult, 0);
+   WriteLn('Passed!');
+
+   Write('Getting current directory again...');
+   getdir(0,newdir);
+   test(IOResult,0);
+   WriteLn('Passed');
+
+   Write('Checking whether the current directories are properly relative to each other...');
+   if newdir[length(newdir)]=DirectorySeparator then
+     setlength(newdir,length(newdir)-1);
+   setcodepage(newdir,CP_UTF8);
+   if copy(newdir,1,length(orgdir))<>orgdir then
+     test(0,1);
+   if copy(newdir,length(newdir)-length(dirname)+1,length(dirname))<>dirname then
+     test(2,3);
+   Writeln('Passed');
+
+   Write('going directory up ...');
+   chdir('..');
+   test(IOResult, 0);
+   WriteLn('Passed!');
+
+   Write('removing directory ...');
+   rmdir(dirname);
+   test(IOResult, 0);
+   WriteLn('Passed!');
+end;
+
+
+procedure testuni;
+const
+  dirname: unicodestring = '鿆®';
+var
+  orgdir, newdir: unicodestring;
+Begin
+   Writeln('unicodestring tests');
+   Write('Getting current directory...');
+   getdir(0,orgdir);
+   test(IOResult,0);
+   WriteLn('Passed');
+   
+   Write('creating new directory...');
+   mkdir(dirname);
+   test(IOResult,0);
+   WriteLn('Passed');
+
+   Write('changing to new directory...');
+   chdir(dirname);
+   test(IOResult, 0);
+   WriteLn('Passed!');
+
+   Write('Getting current directory again...');
+   getdir(0,newdir);
+   test(IOResult,0);
+   WriteLn('Passed');
+
+   Write('Checking whether the current directories are properly relative to each other...');
+   if newdir[length(newdir)]=DirectorySeparator then
+     setlength(newdir,length(newdir)-1);
+   if copy(newdir,1,length(orgdir))<>orgdir then
+     test(0,1);
+   if copy(newdir,length(newdir)-length(dirname)+1,length(dirname))<>dirname then
+     test(2,3);
+   Writeln('Passed');
+
+   Write('going directory up ...');
+   chdir('..');
+   test(IOResult, 0);
+   WriteLn('Passed!');
+
+   Write('removing directory ...');
+   rmdir(dirname);
+   test(IOResult, 0);
+   WriteLn('Passed!');
+end;
+
+begin
+  { ensure that we get into trouble if at one point defaultsystemcodepage is used }
+  SetMultiByteConversionCodePage(CP_ASCII);
+  { this test only works in its current form on systems that either use a two byte file system OS API, or whose 1-byte API supports UTF-8 }
+  SetMultiByteFileSystemCodePage(CP_UTF8);
+  SetMultiByteRTLFileSystemCodePage(CP_UTF8);
+  testansi;
+  testuni;
+end.