[commit: packages/directory] master: Merge pull request #8 from gintas/master (021cc5d)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/021cc5d4cbd164e53897f417e8c21dab99f7c8c9/directory

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

commit 021cc5d4cbd164e53897f417e8c21dab99f7c8c9
Merge: 0c201fa 60667c8
Author: Phil Ruffwind <rf at rufflewind.com>
Date:   Tue Mar 3 19:16:45 2015 -0500

    Merge pull request #8 from gintas/master



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

021cc5d4cbd164e53897f417e8c21dab99f7c8c9
 System/Directory.hs | 26 ++++++++++++++++++++------
 tests/.gitignore    |  1 +
 tests/T8482.hs      | 16 ++++++++++++++++
 tests/T8482.stdout  |  3 +++
 tests/all.T         |  2 ++
 5 files changed, 42 insertions(+), 6 deletions(-)

diff --cc System/Directory.hs
index 695db9c,14b89ff..0e2c071
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@@ -678,18 -637,33 +678,32 @@@ Either path refers to an existing direc
  -}
  
  renameFile :: FilePath -> FilePath -> IO ()
 -renameFile opath npath = do
 -   -- XXX the isDirectory tests are not performed atomically with the rename
 +renameFile opath npath = (`ioeSetLocation` "renameFile") `modifyIOError` do
-    -- XXX this test isn't performed atomically with the following rename
-    dirType <- getDirectoryType opath
-    case dirType of
-      Directory -> ioError . (`ioeSetErrorString` "is a directory") $
-                   mkIOError InappropriateType "" Nothing (Just opath)
-      _         -> return ()
++   -- XXX the 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
 -       -- ToDo: use Win32 API
 -       pathIsDir path = withFileOrSymlinkStatus "renameFile" path isDirectory
 -       doRename = Win32.moveFileEx opath npath Win32.mOVEFILE_REPLACE_EXISTING
 +   Win32.moveFileEx opath npath Win32.mOVEFILE_REPLACE_EXISTING
  #else
 -       pathIsDir path = Posix.isDirectory `fmap` Posix.getSymbolicLinkStatus path
 -       doRename = Posix.rename opath npath
 +   Posix.rename opath npath
  #endif
++     -- The underlying rename implementation can throw odd exceptions when the
++     -- destination is a directory.  For example, Windows typically throws a
++     -- permission error, while POSIX systems may throw a resource busy error
++     -- if one of the paths refers to the current directory.  In these cases,
++     -- we check if the destination is a directory and, if so, throw an
++     -- InappropriateType error.
++     `catchIOError` \ err -> do
++       checkNotDir npath
++       ioError err
++   where checkNotDir path = do
++           dirType <- getDirectoryType path
++                      `catchIOError` \ _ -> return NotDirectory
++           case dirType of
++             Directory     -> errIsDir path
++             DirectoryLink -> errIsDir path
++             NotDirectory  -> return ()
++         errIsDir path = ioError . (`ioeSetErrorString` "is a directory") $
++                         mkIOError InappropriateType "" Nothing (Just path)
  
  #endif /* __GLASGOW_HASKELL__ */
  
diff --cc tests/.gitignore
index d2fe0ee,e675d35..9abd17e
--- a/tests/.gitignore
+++ b/tests/.gitignore
@@@ -23,3 -22,3 +23,4 @@@
  /getPermissions001
  /renameFile001
  /renameFile001.tmp1
++/T8482
diff --cc tests/all.T
index bdde734,ac6c909..3279e5d
--- a/tests/all.T
+++ b/tests/all.T
@@@ -26,3 -25,6 +26,5 @@@ test('createDirectoryIfMissing001',  no
  
  # No sane way to tell whether the output is reasonable here...
  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, [''])