fix #2298: use MoveFileEx() on Windows

diff --git a/System/Directory.hs b/System/Directory.hs
index d7a6dc6..5da67b6 100644 (file)
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -100,6 +100,12 @@ import System.Time             ( ClockTime(..) )
 
 import GHC.IOBase      ( IOException(..), IOErrorType(..), ioException )
 
+#ifdef mingw32_HOST_OS
+import qualified System.Win32
+#else
+import qualified System.Posix
+#endif
+
 {- $intro
 A directory contains a series of entries, each of which is a named
 reference to a file system object (file, directory etc.).  Some
@@ -465,16 +471,18 @@ Either path refers to an existing non-directory object.
 
 renameDirectory :: FilePath -> FilePath -> IO ()
 renameDirectory opath npath =
+   -- XXX this test isn't performed atomically with the following rename
    withFileStatus "renameDirectory" opath $ \st -> do
    is_dir <- isDirectory st
    if (not is_dir)
        then ioException (IOError Nothing InappropriateType "renameDirectory"
                            ("not a directory") (Just opath))
        else do
-
-   withCString opath $ \s1 ->
-     withCString npath $ \s2 ->
-        throwErrnoIfMinus1Retry_ "renameDirectory" (c_rename s1 s2)
+#ifdef mingw32_HOST_OS
+   System.Win32.moveFileEx opath npath System.Win32.mOVEFILE_REPLACE_EXISTING
+#else
+   System.Posix.rename s1 s2
+#endif
 
 {- |@'renameFile' old new@ changes the name of an existing file system
 object from /old/ to /new/.  If the /new/ object already
@@ -522,16 +530,18 @@ Either path refers to an existing directory.
 
 renameFile :: FilePath -> FilePath -> IO ()
 renameFile opath npath =
+   -- XXX this test isn't performed atomically with the following rename
    withFileOrSymlinkStatus "renameFile" opath $ \st -> do
    is_dir <- isDirectory st
    if is_dir
        then ioException (IOError Nothing InappropriateType "renameFile"
                           "is a directory" (Just opath))
        else do
-
-    withCString opath $ \s1 ->
-      withCString npath $ \s2 ->
-         throwErrnoIfMinus1Retry_ "renameFile" (c_rename s1 s2)
+#ifdef mingw32_HOST_OS
+   System.Win32.moveFileEx opath npath System.Win32.mOVEFILE_REPLACE_EXISTING
+#else
+   System.Posix.rename s1 s2
+#endif
 
 #endif /* __GLASGOW_HASKELL__ */
 

diff --git a/directory.cabal b/directory.cabal
index 78acdfe..56ae5a2 100644 (file)
--- a/directory.cabal
+++ b/directory.cabal
@@ -7,15 +7,24 @@ synopsis:     library for directory handling
 description:
        This package provides a library for handling directories.
 build-type: Configure
-exposed-modules:
-       System.Directory
-c-sources:
-       cbits/directory.c
-include-dirs: include
-includes:      HsDirectory.h
-install-includes:      HsDirectory.h HsDirectoryConfig.h
-extensions:    CPP, ForeignFunctionInterface
-build-depends: base, old-time, filepath
 extra-tmp-files:
         config.log config.status autom4te.cache
         include/HsDirectoryConfig.h
+cabal-version: >= 1.2
+
+Library {
+    exposed-modules:
+            System.Directory
+    c-sources:
+            cbits/directory.c
+    include-dirs: include
+    includes: HsDirectory.h
+    install-includes: HsDirectory.h HsDirectoryConfig.h
+    extensions: CPP, ForeignFunctionInterface
+    build-depends: base, old-time, filepath
+    if os(windows) {
+        build-depends: Win32
+    } else {
+        build-depends: unix
+    }
+}