[commit: packages/directory] master: renameFile now consistently reports an error if the destination is a directory, as specified by documentation. (60667c8)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/directory

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/60667c87b8a499a07e1ed0d578cf72dec9806cf7/directory

>---------------------------------------------------------------

commit 60667c87b8a499a07e1ed0d578cf72dec9806cf7
Author: Gintautas Miliauskas <gintautas.miliauskas at gmail.com>
Date:   Mon Nov 3 19:49:04 2014 +0100

    renameFile now consistently reports an error if the destination is a directory, as specified by documentation.
    
    Previously the exceptions raised would be quite inconsistent. For example,
    given a file 'f' and a directory 'd', on Linux, the simple case worked:
    
    Prelude System.Directory> renameFile "f" "d"
    *** Exception: f: rename: inappropriate type (Is a directory)
    
    however:
    
    Prelude System.Directory> renameFile "f" "d/"
    *** Exception: f: rename: inappropriate type (Not a directory)
    Prelude System.Directory> renameFile "f" "."
    *** Exception: e: rename: resource busy (Device or resource busy)
    Prelude System.Directory> renameFile "f" "/tmp"
    *** Exception: e: rename: unsatisified constraints (Directory not empty)
    
    Windows was inconsistent with the documentation even in the general case:
    
    Prelude System.Directory> renameFile "f" "d"
    *** Exception: f: MoveFileEx "f" "d": permission denied (Access is denied.)
    
    The additional check should not incur noticeable cost as an extra stat
    to check for a directory is only performed in case of an IO exception.
    
    I am not sure if this is actually the right abstraction level to fix
    these inconsistencies. Perhaps they should be pushed down to libraries/Win32,
    but the thing is, the Win32 documentation does not try to specify which
    errors are raised in which settings, but System.Directory does, and the
    implementation goes against the documentation, which seems wrong.


>---------------------------------------------------------------

60667c87b8a499a07e1ed0d578cf72dec9806cf7
 System/Directory.hs | 39 +++++++++++++++++++++++----------------
 tests/T8482.hs      | 16 ++++++++++++++++
 tests/T8482.stdout  |  3 +++
 tests/all.T         |  1 +
 4 files changed, 43 insertions(+), 16 deletions(-)

diff --git a/System/Directory.hs b/System/Directory.hs
index 203f4aa..14b89ff 100644
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -638,24 +638,31 @@ Either path refers to an existing directory.
 
 renameFile :: FilePath -> FilePath -> IO ()
 renameFile opath npath = do
-   -- XXX this test isn't performed atomically with the following rename
-#ifdef mingw32_HOST_OS
-   -- ToDo: use Win32 API
-   withFileOrSymlinkStatus "renameFile" opath $ \st -> do
-   is_dir <- isDirectory st
-#else
-   stat <- Posix.getSymbolicLinkStatus opath
-   let is_dir = Posix.isDirectory stat
-#endif
-   if is_dir
-        then ioError (ioeSetErrorString
-                          (mkIOError InappropriateType "renameFile" Nothing (Just opath))
-                          "is a directory")
-        else do
+   -- XXX the isDirectory tests are not performed atomically with the rename
+   checkNotDir opath
+   doRename `E.catch` renameExcHandler
+ where checkNotDir path = do
+                isdir <- pathIsDir path `E.catch` ((\ _ -> return False) :: IOException -> IO Bool)
+                when isdir $ dirIoError path
+       dirIoError path = ioError $ ioeSetErrorString (mkIOError InappropriateType "renameFile" Nothing (Just path)) "is a directory"
+       renameExcHandler :: IOException -> IO ()
+       renameExcHandler exc = do
+                -- The underlying rename implementation throws odd exceptions
+                -- sometimes when the destination is a directory. For example,
+                -- Windows throws a permission error. In those cases check
+                -- if the cause is actually the destination being a directory
+                -- and throw InapprioriateType in that case.
+                checkNotDir npath
+                throw exc
+       doRename :: IO ()
+       pathIsDir :: FilePath -> IO (Bool)
 #ifdef mingw32_HOST_OS
-   Win32.moveFileEx opath npath Win32.mOVEFILE_REPLACE_EXISTING
+       -- ToDo: use Win32 API
+       pathIsDir path = withFileOrSymlinkStatus "renameFile" path isDirectory
+       doRename = Win32.moveFileEx opath npath Win32.mOVEFILE_REPLACE_EXISTING
 #else
-   Posix.rename opath npath
+       pathIsDir path = Posix.isDirectory `fmap` Posix.getSymbolicLinkStatus path
+       doRename = Posix.rename opath npath
 #endif
 
 #endif /* __GLASGOW_HASKELL__ */
diff --git a/tests/T8482.hs b/tests/T8482.hs
new file mode 100644
index 0000000..3bea8af
--- /dev/null
+++ b/tests/T8482.hs
@@ -0,0 +1,16 @@
+import System.Directory
+import Control.Exception
+
+tmp1 = "T8482.tmp1"
+testdir = "T8482.dir"
+
+main = do
+  writeFile tmp1 "hello"
+  createDirectory testdir
+  tryRenameFile testdir tmp1 >>= print  -- InappropriateType
+  tryRenameFile tmp1 testdir >>= print  -- InappropriateType
+  tryRenameFile tmp1 "." >>= print  -- InappropriateType
+  removeDirectory testdir
+  removeFile tmp1
+  where tryRenameFile :: FilePath -> FilePath -> IO (Either IOException ())
+        tryRenameFile opath npath = try $ renameFile opath npath
diff --git a/tests/T8482.stdout b/tests/T8482.stdout
new file mode 100644
index 0000000..277bc18
--- /dev/null
+++ b/tests/T8482.stdout
@@ -0,0 +1,3 @@
+Left T8482.dir: renameFile: inappropriate type (is a directory)
+Left T8482.dir: renameFile: inappropriate type (is a directory)
+Left .: renameFile: inappropriate type (is a directory)
diff --git a/tests/all.T b/tests/all.T
index 4efd688..ac6c909 100644
--- a/tests/all.T
+++ b/tests/all.T
@@ -27,3 +27,4 @@ test('createDirectoryIfMissing001',  normal, compile_and_run, [''])
 test('getHomeDirectory001',  ignore_output, compile_and_run, [''])
 
 test('T4113', when(platform('i386-apple-darwin'), expect_broken(7604)), compile_and_run, [''])
+test('T8482',  normal, compile_and_run, [''])