- removed platform-specific implementations of GetCurrentDir, SetCurrentDir,

    CreateDir and RemoveDir, and implemented a generic one (based on the OS/2
    version) in the shared sysutils code (so that the filesystem code page
    support for the system unit routines can be reused)
  * include both ansistring and unicodestring versions of the above routines,
    and of ForceDirectories. Exception: GetCurrentDir, which cannot be
    overloaded based on function result and whose return type currently
    dependends on the FPC_UNICODE_RTL define

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

.gitattributes

@@ -8573,6 +8573,7 @@ rtl/objpas/strutils.pp svneol=native#text/plain
 rtl/objpas/sysconst.pp svneol=native#text/plain
 rtl/objpas/sysutils/dati.inc svneol=native#text/plain
 rtl/objpas/sysutils/datih.inc svneol=native#text/plain
+rtl/objpas/sysutils/disk.inc svneol=native#text/plain
 rtl/objpas/sysutils/diskh.inc svneol=native#text/plain
 rtl/objpas/sysutils/filutil.inc svneol=native#text/plain
 rtl/objpas/sysutils/filutilh.inc svneol=native#text/plain

rtl/amiga/sysutils.pp

@@ -463,33 +463,6 @@ Begin
   DiskSize := dos.DiskSize(Drive);
 End;
 
-function GetCurrentDir : String;
-begin
-  GetDir (0,Result);
-end;
-
-
-Function SetCurrentDir (Const NewDir : String) : Boolean;
-begin
-  ChDir(NewDir);
-  result := (IOResult = 0);
-end;
-
-
-Function CreateDir (Const NewDir : String) : Boolean;
-begin
-  MkDir(NewDir);
-  result := (IOResult = 0);
-end;
-
-
-Function RemoveDir (Const Dir : String) : Boolean;
-begin
-  RmDir(Dir);
-  result := (IOResult = 0);
-end;
-
-
 function DirectoryExists(const Directory: RawBytetring): Boolean;
 var
   tmpStr : String;

rtl/embedded/sysutils.pp

@@ -181,30 +181,6 @@ Begin
 End;
 
 
-Function GetCurrentDir : String;
-begin
-  result := '';
-end;
-
-
-Function SetCurrentDir (Const NewDir : String) : Boolean;
-begin
-  result := false;
-end;
-
-
-Function CreateDir (Const NewDir : String) : Boolean;
-begin
-  result := false;
-end;
-
-
-Function RemoveDir (Const Dir : String) : Boolean;
-begin
-  result := false;
-end;
-
-
 function DirectoryExists(const Directory: RawByteString): Boolean;
 begin
   result := false;

rtl/emx/sysutils.pp

@@ -1037,39 +1037,6 @@ begin
 end;
 
 
-function GetCurrentDir: string;
-begin
- GetDir (0, Result);
-end;
-
-
-function SetCurrentDir (const NewDir: string): boolean;
-begin
-{$I-}
- ChDir (NewDir);
- Result := (IOResult = 0);
-{$I+}
-end;
-
-
-function CreateDir (const NewDir: string): boolean;
-begin
-{$I-}
- MkDir (NewDir);
- Result := (IOResult = 0);
-{$I+}
-end;
-
-
-function RemoveDir (const Dir: string): boolean;
-begin
-{$I-}
- RmDir (Dir);
- Result := (IOResult = 0);
- {$I+}
-end;
-
-
 function DirectoryExists (const Directory: RawByteString): boolean;
 var
   L: longint;

rtl/gba/sysutils.pp

@@ -200,30 +200,6 @@ Begin
 End;
 
 
-Function GetCurrentDir : String;
-begin
-  result := '';
-end;
-
-
-Function SetCurrentDir (Const NewDir : String) : Boolean;
-begin
-  result := false;
-end;
-
-
-Function CreateDir (Const NewDir : String) : Boolean;
-begin
-  result := false;
-end;
-
-
-Function RemoveDir (Const Dir : String) : Boolean;
-begin
-  result := false;
-end;
-
-
 function DirectoryExists(const Directory: RawByteString): Boolean;
 begin
   result := false;

rtl/go32v2/sysutils.pp

@@ -628,39 +628,6 @@ begin
 end;
 
 
-Function GetCurrentDir : String;
-begin
-  GetDir(0, result);
-end;
-
-
-Function SetCurrentDir (Const NewDir : String) : Boolean;
-begin
-  {$I-}
-   ChDir(NewDir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
-Function CreateDir (Const NewDir : String) : Boolean;
-begin
-  {$I-}
-   MkDir(NewDir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
-Function RemoveDir (Const Dir : String) : Boolean;
-begin
-  {$I-}
-   RmDir(Dir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
 {****************************************************************************
                               Time Functions
 ****************************************************************************}

rtl/macos/sysutils.pp

@@ -562,39 +562,6 @@ Begin
   *)
 End;
 
-Function GetCurrentDir : String;
-begin
-  GetDir (0,Result);
-end;
-
-
-Function SetCurrentDir (Const NewDir : String) : Boolean;
-begin
-  {$I-}
-   ChDir(NewDir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
-Function CreateDir (Const NewDir : String) : Boolean;
-begin
-  {$I-}
-   MkDir(NewDir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
-Function RemoveDir (Const Dir : String) : Boolean;
-begin
-  {$I-}
-   RmDir(Dir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
 {****************************************************************************
                               Misc Functions
 ****************************************************************************}

rtl/morphos/sysutils.pp

@@ -535,33 +535,6 @@ Begin
   DiskSize := dos.DiskSize(Drive);
 End;
 
-function GetCurrentDir : String;
-begin
-  GetDir (0,Result);
-end;
-
-
-Function SetCurrentDir (Const NewDir : String) : Boolean;
-begin
-  ChDir(NewDir);
-  result := (IOResult = 0);
-end;
-
-
-Function CreateDir (Const NewDir : String) : Boolean;
-begin
-  MkDir(NewDir);
-  result := (IOResult = 0);
-end;
-
-
-Function RemoveDir (Const Dir : String) : Boolean;
-begin
-  RmDir(Dir);
-  result := (IOResult = 0);
-end;
-
-
 function DirectoryExists(const Directory: RawByteString): Boolean;
 var
   tmpLock: LongInt;

rtl/msdos/sysutils.pp

@@ -610,39 +610,6 @@ begin
 end;
 
 
-Function GetCurrentDir : String;
-begin
-  GetDir(0, result);
-end;
-
-
-Function SetCurrentDir (Const NewDir : String) : Boolean;
-begin
-  {$I-}
-   ChDir(NewDir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
-Function CreateDir (Const NewDir : String) : Boolean;
-begin
-  {$I-}
-   MkDir(NewDir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
-Function RemoveDir (Const Dir : String) : Boolean;
-begin
-  {$I-}
-   RmDir(Dir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
 {****************************************************************************
                               Time Functions
 ****************************************************************************}

rtl/nativent/sysutils.pp

@@ -948,39 +948,6 @@ begin
 end;
 
 
-function GetCurrentDir: String;
-begin
-  GetDir(0, result);
-end;
-
-
-function SetCurrentDir(const NewDir: String): Boolean;
-begin
-{$I-}
-  ChDir(NewDir);
-{$I+}
-  Result := IOResult = 0;
-end;
-
-
-function CreateDir(const NewDir: String): Boolean;
-begin
-{$I-}
-  MkDir(NewDir);
-{$I+}
-  Result := IOResult = 0;
-end;
-
-
-function RemoveDir(const Dir: String): Boolean;
-begin
-{$I-}
-  RmDir(Dir);
-{$I+}
-  Result := IOResult = 0;
-end;
-
-
 {****************************************************************************
                               Time Functions
 ****************************************************************************}

rtl/nds/sysutils.pp

@@ -240,30 +240,6 @@ Begin
 End;
 
 
-Function GetCurrentDir : String;
-begin
-  result := '';
-end;
-
-
-Function SetCurrentDir (Const NewDir : String) : Boolean;
-begin
-  result := false;
-end;
-
-
-Function CreateDir (Const NewDir : String) : Boolean;
-begin
-  result := false;
-end;
-
-
-Function RemoveDir (Const Dir : String) : Boolean;
-begin
-  result := false;
-end;
-
-
 function DirectoryExists(const Directory: RawByteString): Boolean;
 begin
   result := false;

rtl/netware/sysutils.pp

@@ -434,39 +434,6 @@ Begin
 End;
 
 
-Function GetCurrentDir : String;
-begin
-  GetDir (0,Result);
-end;
-
-
-Function SetCurrentDir (Const NewDir : String) : Boolean;
-begin
-  {$I-}
-   ChDir(NewDir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
-Function CreateDir (Const NewDir : String) : Boolean;
-begin
-  {$I-}
-   MkDir(NewDir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
-Function RemoveDir (Const Dir : String) : Boolean;
-begin
-  {$I-}
-   RmDir(Dir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
 function DirectoryExists (const Directory: string): boolean;
 var
   Info : NWStatBufT;

rtl/netwlibc/sysutils.pp

@@ -491,33 +491,6 @@ Begin
 End;
 
 
-Function GetCurrentDir : String;
-begin
-  GetDir (0,Result);
-end;
-
-
-Function SetCurrentDir (Const NewDir : String) : Boolean;
-begin
-  Libc.FpChDir(pchar(NewDir));
-  result := (___errno^ = 0);
-end;
-
-
-Function CreateDir (Const NewDir : String) : Boolean;
-begin
-  Libc.FpMkDir(pchar(NewDir),0);
-  result := (___errno^ = 0);
-end;
-
-
-Function RemoveDir (Const Dir : String) : Boolean;
-begin
-  libc.FpRmDir(pchar(Dir));
-  result := (___errno^ = 0);
-end;
-
-
 function DirectoryExists (const Directory: RawByteString): boolean;
 var
   Info : TStat;

rtl/objpas/sysutils/disk.inc

@@ -0,0 +1,116 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2012 by the Free Pascal development team
+
+    Disk calls
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{$push}
+{$i-}
+Function SetCurrentDir(Const NewDir: PathStr): Boolean;
+var
+  PInOutRes: ^Word;
+  OrigInOutRes: Word;
+begin
+  { inoutres is a threadvar -> cache address }
+  PInOutRes:=@InOutRes;
+  OrigInOutRes:=PInOutRes^;
+  PInOutRes^:=0;
+  ChDir(NewDir);
+  Result:=PInOutRes^=0;
+  InOutRes:=OrigInOutRes;
+end;
+
+
+Function CreateDir (Const NewDir: PathStr): Boolean;
+var
+  PInOutRes: ^Word;
+  OrigInOutRes: Word;
+begin
+  { inoutres is a threadvar -> cache address }
+  PInOutRes:=@InOutRes;
+  OrigInOutRes:=PInOutRes^;
+  PInOutRes^:=0;
+  MkDir(NewDir);
+  Result:=PInOutRes^=0;
+  InOutRes:=OrigInOutRes;
+end;
+
+
+Function RemoveDir (Const Dir: PathStr): Boolean;
+var
+  PInOutRes: ^Word;
+  OrigInOutRes: Word;
+begin
+  { inoutres is a threadvar -> cache address }
+  PInOutRes:=@InOutRes;
+  OrigInOutRes:=PInOutRes^;
+  PInOutRes^:=0;
+  RmDir(Dir);
+  Result:=PInOutRes^=0;
+  InOutRes:=OrigInOutRes;
+end;
+{$pop}
+
+
+function ForceDirectories(Const Dir: PathStr): Boolean;
+var
+  E: EInOutError;
+  ADrv: PathStr;
+
+  function DoForceDirectories(Const Dir: PathStr): Boolean;
+  var
+    ADir: PathStr;
+    APath: PathStr;
+  begin
+    Result:=True;
+    ADir:=ExcludeTrailingPathDelimiter(Dir);
+    if (ADir='') then Exit;
+    if Not DirectoryExists(ADir) then
+      begin
+        APath:=ExtractFilePath(ADir);
+        //this can happen on Windows if user specifies Dir like \user\name/test/
+        //and would, if not checked for, cause an infinite recusrsion and a stack overflow
+        if (APath=ADir) then
+          Result:=False
+        else
+          Result:=DoForceDirectories(APath);
+      if Result then
+        Result:=CreateDir(ADir);
+      end;
+  end;
+
+  function IsUncDrive(const Drv: PathStr): Boolean;
+  begin
+    Result:=
+      (Length(Drv)>2) and
+      (Drv[1]=PathDelim) and
+      (Drv[2]=PathDelim);
+  end;
+
+begin
+  Result:=False;
+  ADrv:=ExtractFileDrive(Dir);
+  if (ADrv<>'') and
+     (not DirectoryExists(ADrv))
+     {$IFNDEF FORCEDIR_NO_UNC_SUPPORT} and (not IsUncDrive(ADrv)){$ENDIF} then
+    Exit;
+  if Dir='' then
+    begin
+      E:=EInOutError.Create(SCannotCreateEmptyDir);
+      E.ErrorCode:=3;
+      Raise E;
+    end;
+  Result:=DoForceDirectories(SetDirSeparators(Dir));
+end;
+
+

rtl/objpas/sysutils/diskh.inc

@@ -15,9 +15,15 @@
 
 Function  DiskFree(drive: byte) : int64;
 Function  DiskSize(drive: byte) : int64;
-Function GetCurrentDir : String;
-Function SetCurrentDir (Const NewDir : String) : Boolean;
-Function CreateDir (Const NewDir : String) : Boolean;
-Function RemoveDir (Const Dir : String) : Boolean;
-Function ForceDirectories(Const Dir: string): Boolean;
+Function GetCurrentDir : {$ifdef FPC_UNICODE_RTL}UnicodeString{$else}AnsiString{$endif};
+
+Function SetCurrentDir (Const NewDir : AnsiString) : Boolean;
+Function CreateDir (Const NewDir : AnsiString) : Boolean;
+Function RemoveDir (Const Dir : AnsiString) : Boolean;
+Function ForceDirectories(Const Dir: AnsiString): Boolean;
+
+Function SetCurrentDir (Const NewDir : UnicodeString) : Boolean;
+Function CreateDir (Const NewDir : UnicodeString) : Boolean;
+Function RemoveDir (Const Dir : UnicodeString) : Boolean;
+Function ForceDirectories(Const Dir: UnicodeString): Boolean;
 

rtl/objpas/sysutils/sysutils.inc

@@ -21,10 +21,14 @@
 {$define PathPChar:=PWideChar}
   { Read filename handling functions implementation }
   {$i fina.inc}
+  { Read disk function implementations }
+  {$i disk.inc}
 {$define PathStr:=AnsiString}
 {$define PathPChar:=PAnsiChar}
   { Read filename handling functions implementation }
   {$i fina.inc}
+  { Read disk function implementations }
+  {$i disk.inc}
 {$undef PathStr}
 {$undef PathPChar}
 
@@ -634,50 +638,14 @@ end;
     Diskh functions, OS independent.
   ---------------------------------------------------------------------}
 
-function ForceDirectories(Const Dir: string): Boolean;
-
-var
-  E: EInOutError;
-  ADrv : String;
-
-function DoForceDirectories(Const Dir: string): Boolean;
-var
-  ADir : String;
-  APath: String;
-begin
-  Result:=True;
-  ADir:=ExcludeTrailingPathDelimiter(Dir);
-  if (ADir='') then Exit;
-  if Not DirectoryExists(ADir) then
-    begin
-      APath := ExtractFilePath(ADir);
-      //this can happen on Windows if user specifies Dir like \user\name/test/
-      //and would, if not checked for, cause an infinite recusrsion and a stack overflow
-      if (APath = ADir) then Result := False
-        else Result:=DoForceDirectories(APath);
-    If Result then
-      Result := CreateDir(ADir);
-    end;
-end;
-
-function IsUncDrive(const Drv: String): Boolean;
+Function GetCurrentDir: {$ifdef FPC_UNICODE_RTL}UnicodeString{$else}AnsiString{$endif};
 begin
-  Result := (Length(Drv) > 2) and (Drv[1] = PathDelim) and (Drv[2] = PathDelim);
+  GetDir(0,Result);
 end;
 
-begin
-  Result := False;
-  ADrv := ExtractFileDrive(Dir);
-  if (ADrv<>'') and (not DirectoryExists(ADrv))
-  {$IFNDEF FORCEDIR_NO_UNC_SUPPORT} and (not IsUncDrive(ADrv)){$ENDIF} then Exit;
-  if Dir='' then
-    begin
-      E:=EInOutError.Create(SCannotCreateEmptyDir);
-      E.ErrorCode:=3;
-      Raise E;
-    end;
-  Result := DoForceDirectories(SetDirSeparators(Dir));
-end;
+{ ---------------------------------------------------------------------
+    Other functions, OS independent.
+  ---------------------------------------------------------------------}
 
 Var
   GUIDCalledRandomize : Boolean = False;

rtl/os2/sysutils.pp

@@ -407,54 +407,6 @@ begin
 end;
 
 
-function GetCurrentDir: string;
-begin
- GetDir (0, Result);
-end;
-
-
-function SetCurrentDir (const NewDir: string): boolean;
-var
- OrigInOutRes: word;
-begin
- OrigInOutRes := InOutRes;
- InOutRes := 0;
-{$I-}
- ChDir (NewDir);
- Result := InOutRes = 0;
-{$I+}
- InOutRes := OrigInOutRes;
-end;
-
-
-function CreateDir (const NewDir: string): boolean;
-var
- OrigInOutRes: word;
-begin
- OrigInOutRes := InOutRes;
- InOutRes := 0;
-{$I-}
- MkDir (NewDir);
- Result := InOutRes = 0;
-{$I+}
- InOutRes := OrigInOutRes;
-end;
-
-
-function RemoveDir (const Dir: string): boolean;
-var
- OrigInOutRes: word;
-begin
- OrigInOutRes := InOutRes;
- InOutRes := 0;
-{$I-}
- RmDir (Dir);
- Result := InOutRes = 0;
-{$I+}
- InOutRes := OrigInOutRes;
-end;
-
-
 function DirectoryExists (const Directory: RawByteString): boolean;
 var
   L: longint;

rtl/unix/sysutils.pp

@@ -998,40 +998,6 @@ begin
 end;
 
 
-
-Function GetCurrentDir : String;
-begin
-  GetDir (0,Result);
-end;
-
-
-Function SetCurrentDir (Const NewDir : String) : Boolean;
-begin
-  {$I-}
-   ChDir(NewDir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
-Function CreateDir (Const NewDir : String) : Boolean;
-begin
-  {$I-}
-   MkDir(NewDir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
-Function RemoveDir (Const Dir : String) : Boolean;
-begin
-  {$I-}
-   RmDir(Dir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
 {****************************************************************************
                               Misc Functions
 ****************************************************************************}

rtl/watcom/sysutils.pp

@@ -611,39 +611,6 @@ begin
 end;
 
 
-Function GetCurrentDir : String;
-begin
-  GetDir(0, result);
-end;
-
-
-Function SetCurrentDir (Const NewDir : String) : Boolean;
-begin
-  {$I-}
-   ChDir(NewDir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
-Function CreateDir (Const NewDir : String) : Boolean;
-begin
-  {$I-}
-   MkDir(NewDir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
-Function RemoveDir (Const Dir : String) : Boolean;
-begin
-  {$I-}
-   RmDir(Dir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
 {****************************************************************************
                               Time Functions
 ****************************************************************************}

rtl/wii/sysutils.pp

@@ -193,30 +193,6 @@ Begin
 End;
 
 
-Function GetCurrentDir : String;
-begin
-  result := '';
-end;
-
-
-Function SetCurrentDir (Const NewDir : String) : Boolean;
-begin
-  result := false;
-end;
-
-
-Function CreateDir (Const NewDir : String) : Boolean;
-begin
-  result := false;
-end;
-
-
-Function RemoveDir (Const Dir : String) : Boolean;
-begin
-  result := false;
-end;
-
-
 function DirectoryExists(const Directory: string): Boolean;
 begin
   result := false;

rtl/win/sysutils.pp

@@ -570,30 +570,6 @@ begin
 end;
 
 
-Function GetCurrentDir : String;
-begin
-  GetDir(0, result);
-end;
-
-
-Function SetCurrentDir (Const NewDir : String) : Boolean;
-begin
-  Result:=SetCurrentDirectory(PChar(NewDir));
-end;
-
-
-Function CreateDir (Const NewDir : String) : Boolean;
-begin
-  Result:=CreateDirectory(PChar(NewDir),nil);
-end;
-
-
-Function RemoveDir (Const Dir : String) : Boolean;
-begin
-  Result:=RemoveDirectory(PChar(Dir));
-end;
-
-
 {****************************************************************************
                               Time Functions
 ****************************************************************************}

rtl/wince/sysutils.pp

@@ -415,39 +415,6 @@ begin
 end;
 
 
-Function GetCurrentDir : String;
-begin
-  GetDir(0, result);
-end;
-
-
-Function SetCurrentDir (Const NewDir : String) : Boolean;
-begin
-  {$I-}
-   ChDir(NewDir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
-Function CreateDir (Const NewDir : String) : Boolean;
-begin
-  {$I-}
-   MkDir(NewDir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
-Function RemoveDir (Const Dir : String) : Boolean;
-begin
-  {$I-}
-   RmDir(Dir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
 {****************************************************************************
                               Time Functions
 ****************************************************************************}