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/tassignd.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/testpc.txt 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
     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,
     for details about the copyright.
@@ -18,15 +18,14 @@
 {*****************************************************************************
                            Directory Handling
 *****************************************************************************}
-procedure mkdir(s : pchar; len : sizeuint); [IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+procedure do_mkdir(const s : rawbytestring);
 var
-  tmpStr : array[0..255] of char;
+  tmpStr : rawbytestring;
   tmpLock: LongInt;
 begin
   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
     dosError2InOut(IoErr);
     exit;
@@ -34,33 +33,35 @@ begin
   UnLock(tmpLock);
 end;
 
-procedure rmdir(s : pchar; len : sizeuint); [IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+procedure do_rmdir(const s : rawbytestring);
 var
-  tmpStr : array[0..255] of Char;
+  tmpStr : rawbytestring;
 begin
   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);
 end;
 
-procedure sys_chdir(s : pchar);
+procedure do_ChDir(const s: rawbytestring);
 var
-  tmpStr : array[0..255] of Char;
+  tmpStr : rawbytestring;
   tmpLock: LongInt;
   FIB    : PFileInfoBlock;
 begin
   checkCTRLC;
-  If (s='') or (InOutRes<>0) then exit;
-  tmpStr:=PathConv(s)+#0;
+  tmpStr:=PathConv(s);
   tmpLock:=0;
 
   { Changing the directory is a pretty complicated affair }
   {   1) Obtain a lock on the directory                   }
   {   2) CurrentDir the lock                              }
-  tmpLock:=Lock(@tmpStr,SHARED_LOCK);
+  tmpLock:=Lock(pchar(tmpStr),SHARED_LOCK);
   if tmpLock=0 then begin
     dosError2InOut(IoErr);
     exit;
@@ -81,13 +82,6 @@ begin
   if assigned(FIB) then dispose(FIB);
 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);
 var tmpbuf: array[0..255] of char;
 begin

+ 25 - 5
rtl/embedded/sysdir.inc

@@ -19,29 +19,49 @@
 {*****************************************************************************
                            Directory Handling
 *****************************************************************************}
-procedure mkdir(s: pchar;len:sizeuint);[IOCheck];
+{$if defined(FPC_HAS_FEATURE_ANSISTRINGS)}
+procedure do_mkdir(const s: rawbytestring);
 begin
   InOutRes:=3;
 end;
 
-procedure rmdir(s: pchar;len:sizeuint);[IOCheck];
+procedure do_rmdir(const s: rawbytestring);
 begin
   InOutRes:=3;
 end;
 
-procedure chdir(s: pchar;len:sizeuint);[IOCheck];
+procedure do_chdir(const s: rawbytestring);
 begin
   InOutRes:=3;
 end;
 
-{$if defined(FPC_HAS_FEATURE_ANSISTRINGS)}
 procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);
+begin
+  InOutRes:=3;
+end;
+
 {$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);
-{$endif FPC_HAS_FEATURE_ANSISTRINGS}
 begin
   InOutRes:=3;
 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
     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,
     for details about the copyright.
@@ -19,7 +19,7 @@
                            Directory Handling
 *****************************************************************************}
 
-procedure DosDir (Func: byte; S: PChar);
+procedure DosDir (Func: byte; S: rawbytestring);
 
 begin
   DoDirSeparators (S);
@@ -33,17 +33,14 @@ begin
   end ['eax', 'edx'];
 end;
 
-procedure MkDir (S: pchar; Len: SizeUInt); [IOCheck, public, alias: 'FPC_SYS_MKDIR'];
+procedure do_MkDir (S: rawbytestring);
 var 
   RC: cardinal;
 begin
-  if not Assigned (S) or (Len = 0) or (InOutRes <> 0) then
-   Exit;
-
   if os_mode = osOs2 then
    begin
     DoDirSeparators (S);
-    RC := DosCreateDir (S, nil);
+    RC := DosCreateDir (pchar(S), nil);
     if RC <> 0 then
      begin
       InOutRes := RC;
@@ -60,49 +57,46 @@ begin
 end;
 
 
-procedure RmDir (S: PChar; Len: SizeUInt); [IOCheck, public, alias: 'FPC_SYS_RMDIR'];
+procedure do_RmDir (S: rawbytestring);
 var
   RC: cardinal;
 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
-       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;
 
 
 {$ASMMODE INTEL}
 
-procedure ChDir (S: PChar; Len: SizeUInt); [IOCheck, public, alias: 'FPC_SYS_CHDIR'];
+procedure do_ChDir (S: rawbytestring);
 var
   RC: cardinal;
+  Len: longint;
 begin
-  if not Assigned (S) or (Len = 0) or (InOutRes <> 0) then
-    exit;
 (* According to EMX documentation, EMX has only one current directory
    for all processes, so we'll use native calls under OS/2. *)
+  Len := Length (S);
   if os_Mode = osOS2 then
    begin
-    if (Len >= 2) and (S [1] = ':') then
+    if (Len >= 2) and (S [2] = ':') then
      begin
-      RC := DosSetDefaultDisk ((Ord (S^) and not ($20)) - $40);
+      RC := DosSetDefaultDisk ((Ord (S[1]) and not ($20)) - $40);
       if RC <> 0 then
        begin
         InOutRes := RC;
@@ -112,7 +106,7 @@ begin
        if Len > 2 then
         begin
          DoDirSeparators (S);
-         RC := DosSetCurrentDir (S);
+         RC := DosSetCurrentDir (pchar(S));
          if RC <> 0 then
           begin
            InOutRes := RC;
@@ -123,7 +117,7 @@ begin
     else
      begin
       DoDirSeparators (S);
-      RC := DosSetCurrentDir (S);
+      RC := DosSetCurrentDir (pchar(S));
       if RC <> 0 then
        begin
         InOutRes:= RC;
@@ -132,7 +126,7 @@ begin
      end;
    end
   else
-   if (Len >= 2) and (S [1] = ':') then
+   if (Len >= 2) and (S [2] = ':') then
     begin
      asm
       mov esi, S

+ 3 - 3
rtl/gba/sysdir.inc

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

+ 23 - 22
rtl/go32v2/sysdir.inc

@@ -3,7 +3,7 @@
     Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski
     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,
     for details about the copyright.
@@ -18,18 +18,20 @@
                            Directory Handling
 *****************************************************************************}
 
-procedure DosDir(func:byte;s:pchar;len:integer);
+procedure DosDir(func:byte;s:rawbytestring);
 var
   regs   : trealregs;
+  len    : longint;
 begin
   DoDirSeparators(s);
   { True DOS does not like backslashes at end
     Win95 DOS accepts this !!
     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.realds:=tb_segment;
   if LFNSupport then
@@ -41,32 +43,31 @@ begin
    GetInOutRes(lo(regs.realeax));
 end;
 
-Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+Procedure do_MkDir(const s: rawbytestring);
 begin
- If not assigned(s) or (len=0) or (InOutRes <> 0) then
-   exit;
-  DosDir($39,s,len);
+  DosDir($39,s);
 end;
 
-Procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+Procedure do_RmDir(const s: rawbytestring);
 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;
 
-Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+Procedure do_ChDir(const s: rawbytestring);
 var
   regs : trealregs;
+  len  : longint;
 begin
-  If not assigned(s) or (len=0) or (InOutRes <> 0) then
-   exit;
+  len:=length(s);
 { First handle Drive changes }
-  if (len>=2) and (s[1]=':') then
+  if (len>=2) and (s[2]=':') then
    begin
-     regs.realedx:=(ord(s[0]) and (not 32))-ord('A');
+     regs.realedx:=(ord(s[1]) and (not 32))-ord('A');
      regs.realeax:=$0e00;
      sysrealintr($21,regs);
      regs.realeax:=$1900;
@@ -82,7 +83,7 @@ begin
        exit;
    end;
 { do the normal dos chdir }
-  DosDir($3b,s,len);
+  DosDir($3b,s);
 end;
 
 procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);

+ 102 - 36
rtl/inc/system.inc

@@ -1501,58 +1501,43 @@ end;
 {$ifdef FPC_HAS_FEATURE_FILEIO}
 { OS dependent dir functions }
 {$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
   If (s='') or (InOutRes <> 0) then
    exit;
-  Move(s[1], Buffer, Length(s));
-  Buffer[Length(s)] := #0;
-  MkDir(@buffer[0],length(s));
+  Do_mkdir(S);
 End;
 
-Procedure RmDir(Const s: String);
-Var
-  Buffer: Array[0..255] of Char;
+
+Procedure RmDir(Const s: RawByteString);[IOCheck];
 Begin
   If (s='') or (InOutRes <> 0) then
    exit;
-  Move(s[1], Buffer, Length(s));
-  Buffer[Length(s)] := #0;
-  RmDir(@buffer[0],length(s));
+  Do_rmdir(S);
 End;
 
-Procedure ChDir(Const s: String);
-Var
-  Buffer: Array[0..255] of Char;
+
+Procedure ChDir(Const s: RawByteString);[IOCheck];
 Begin
   If (s='') or (InOutRes <> 0) then
    exit;
-  Move(s[1], Buffer, Length(s));
-  Buffer[Length(s)] := #0;
-  ChDir(@buffer[0],length(s));
+  Do_chdir(S);
 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);
 begin
@@ -1562,9 +1547,47 @@ begin
   setcodepage(dir,DefaultRTLFileSystemCodePage,true);
 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);
 var
   s: rawbytestring;
@@ -1581,6 +1604,26 @@ end;
 {$if defined(FPC_HAS_FEATURE_WIDESTRINGS)}
 
 {$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);
 var
   s: rawbytestring;
@@ -1590,6 +1633,29 @@ begin
 end;
 {$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);
 begin

+ 11 - 6
rtl/inc/systemh.inc

@@ -1178,24 +1178,29 @@ procedure SetTextCodePage(var T: Text; CodePage: TSystemCodePage);
                             Directory Management
 ****************************************************************************}
 
-
 {$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;
 {$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
 Procedure getdir(drivenr:byte;var dir: rawbytestring);overload;{$ifdef FPC_HAS_CPSTRING}rtlproc;{$endif FPC_HAS_CPSTRING}
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 {$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;
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
 
 {$endif FPC_HAS_FEATURE_FILEIO}
 
+
+
 {*****************************************************************************
                              Miscellaneous
 *****************************************************************************}

+ 4 - 12
rtl/macos/sysdir.inc

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

+ 17 - 17
rtl/morphos/sysdir.inc

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

+ 22 - 21
rtl/msdos/sysdir.inc

@@ -18,19 +18,21 @@
                            Directory Handling
 *****************************************************************************}
 
-procedure DosDir(func:byte;s:pchar;len:integer);
+procedure DosDir(func:byte;s: rawbytestring);
 var
   regs   : Registers;
+  len    : Longint;
 begin
   DoDirSeparators(s);
   { True DOS does not like backslashes at end
     Win95 DOS accepts this !!
     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
    regs.AX:=$7100+func
   else
@@ -40,32 +42,31 @@ begin
    GetInOutRes(regs.AX);
 end;
 
-Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+Procedure do_MkDir(const s: rawbytestring);
 begin
-  If not assigned(s) or (len=0) or (InOutRes <> 0) then
-    exit;
-   DosDir($39,s,len);
+   DosDir($39,s);
 end;
 
-Procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+Procedure do_RmDir(const s: rawbytestring);
 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;
 
-Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+Procedure do_ChDir(const s: rawbytestring);
 var
   regs : Registers;
+  len  : Longint;
 begin
-  If not assigned(s) or (len=0) or (InOutRes <> 0) then
-   exit;
+  len:=Length(s);
 { First handle Drive changes }
-  if (len>=2) and (s[1]=':') then
+  if (len>=2) and (s[2]=':') then
    begin
-     regs.DX:=(ord(s[0]) and (not 32))-ord('A');
+     regs.DX:=(ord(s[1]) and (not 32))-ord('A');
      regs.AX:=$0e00;
      MsDos(regs);
      regs.AX:=$1900;

+ 15 - 14
rtl/nativent/sysdir.inc

@@ -17,7 +17,7 @@
                            Directory Handling
 *****************************************************************************}
 
-procedure MkDir(s: pchar; len: sizeuint); [IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+procedure do_MkDir(const s: UnicodeString);
 var
   objattr: TObjectAttributes;
   name: TNtUnicodeString;
@@ -25,10 +25,7 @@ var
   iostatus: TIOStatusBlock;
   h: THandle;
 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 }
   SysInitializeObjectAttributes(objattr, @name, OBJ_PERMANENT, 0, Nil);
@@ -61,7 +58,7 @@ begin
   SysFreeNtStr(name);
 end;
 
-procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+procedure do_RmDir(const s: UnicodeString);
 var
   ntstr: TNtUnicodeString;
   objattr: TObjectAttributes;
@@ -70,14 +67,18 @@ var
   disp: TFileDispositionInformation;
   res: LongInt;
 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);
 
   res := NtOpenDirectoryObject(@h, STANDARD_RIGHTS_REQUIRED, @objattr);
@@ -115,7 +116,7 @@ begin
   Errno2InoutRes;
 end;
 
-procedure ChDir(s: pchar; len: sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+procedure do_ChDir(const s: UnicodeString);
 begin
   { for now this is not supported }
   InOutRes := 3;

+ 3 - 6
rtl/nds/sysdir.inc

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

+ 10 - 11
rtl/netware/sysdir.inc

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

+ 6 - 5
rtl/netwlibc/sysdir.inc

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

+ 0 - 33
rtl/objpas/objpas.pp

@@ -87,12 +87,6 @@ Var
      Function ParamStr(Param : Integer) : Ansistring;
 {$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.
 ****************************************************************************}
@@ -130,9 +124,6 @@ Var
 ****************************************************************************}
 
 {$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 }
 
@@ -233,30 +224,6 @@ Function ParamStr(Param : Integer) : ansistring;
   end;
 {$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}
 { ---------------------------------------------------------------------
     ResourceString support

+ 16 - 17
rtl/os2/sysdir.inc

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

+ 3 - 3
rtl/symbian/sysdir.inc

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

+ 17 - 25
rtl/unix/sysdir.inc

@@ -18,7 +18,6 @@
                            Directory Handling
 *****************************************************************************}
 
-Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
 const
   { read/write search permission for everyone }
   MODE_MKDIR = S_IWUSR OR S_IRUSR OR
@@ -26,39 +25,32 @@ const
                S_IWOTH OR S_IROTH OR
                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
-  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
-  Else
-   InOutRes:=0;
 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
-  Else
-   InOutRes:=0;
 End;
 
-Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+
+Procedure do_ChDir(s: rawbytestring);
+
 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 }
   if InOutRes=2 then
    InOutRes:=3;

+ 14 - 12
rtl/watcom/sysdir.inc

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

+ 10 - 10
rtl/wii/sysdir.inc

@@ -18,28 +18,28 @@
 {*****************************************************************************
                            Directory Handling
 *****************************************************************************}
-procedure mkdir(s: pchar; len: sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+procedure do_mkdir(const s: rawbytestring);
 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
-    FileIODevice.DirIO.DoMkdir(strpas(s));
+    FileIODevice.DirIO.DoMkdir(s);
 end;
 
-procedure rmdir(s: pchar; len: sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+procedure do_rmdir(const s: rawbytestring);
 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
-    FileIODevice.DirIO.DoRmdir(strpas(s));
+    FileIODevice.DirIO.DoRmdir(s);
 end;
 
-procedure chdir(s: pchar; len: sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+procedure do_chdir(const s: rawbytestring);
 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
-    FileIODevice.DirIO.DoChdir(strpas(s));
+    FileIODevice.DirIO.DoChdir(pchar(s));
 end;
 
-procedure GetDir(DriveNr: byte; var Dir: RawByteString);
+procedure do_GetDir(DriveNr: byte; var Dir: RawByteString);
 var
   TmpDir: ShortString;
 begin

+ 25 - 28
rtl/win/sysdir.inc

@@ -20,53 +20,50 @@
 type
  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
   DoDirSeparators(s);
-  if not aFunc(s) then
+  if not aFunc(punicodechar(s)) then
     begin
       errno:=GetLastError;
       Errno2InoutRes;
     end;
 end;
-
-function CreateDirectoryTrunc(name:pointer):longbool;stdcall;
+Procedure do_MkDir(const s: UnicodeString);
 begin
-  CreateDirectoryTrunc:=CreateDirectory(name,nil);
+  dirfn(TDirFnType(@CreateDirectoryTrunc),s);
 end;
 
-Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+Procedure do_RmDir(const s: UnicodeString);
 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}
   if (Inoutres=3) and (Pos(DirectorySeparator, s)<2) then
     Inoutres:=2;
 {$endif WINCE}
 end;
 
-Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
-
+Procedure do_ChDir(const s: UnicodeString);
 begin
 {$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
    Inoutres:=3;
 {$else WINCE}

+ 4 - 15
rtl/win/sysos.inc

@@ -291,13 +291,6 @@ threadvar
                        lpSecurityAttributes:PSECURITYATTRIBUTES; dwCreationDisposition:DWORD;
                        dwFlagsAndAttributes:DWORD; hTemplateFile:DWORD):THandle;
      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}
    function GetFileAttributes(p : pchar) : dword;
      stdcall;external KernelDLL name 'GetFileAttributesA';
@@ -309,16 +302,12 @@ threadvar
                        lpSecurityAttributes:PSECURITYATTRIBUTES; dwCreationDisposition:DWORD;
                        dwFlagsAndAttributes:DWORD; hTemplateFile:DWORD):THandle;
      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}
    { 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;
      stdcall;external KernelDLL name 'SetCurrentDirectoryW';
    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;
                    dwFlagsAndAttributes:DWORD; hTemplateFile:DWORD):longint;
 
-function CreateDirectory(name : pointer;sec : pointer) : longbool;
-function RemoveDirectory(name:pointer):longbool;
-
 
 {$ifdef CPUARM}
 { 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;
    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}
@@ -424,10 +427,6 @@ function CreateFileW(lpFileName:pwidechar; dwDesiredAccess:DWORD; dwShareMode:DW
                    lpSecurityAttributes:pointer; dwCreationDisposition:DWORD;
                    dwFlagsAndAttributes:DWORD; hTemplateFile:DWORD):longint;
     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;
 var
@@ -465,22 +464,6 @@ begin
                             dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile);
 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
 {$ifdef CPUARM}
   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.