[commit: ghc] master: Replace createDirectoryHierarchy with createDirectoryIfMissing True (ffe282c)

[Simon Marlow]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/ffe282cef4213ab8de515a8574d366994d38d5dd

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

commit ffe282cef4213ab8de515a8574d366994d38d5dd
Author: Takano Akio <aljee at hyper.cx>
Date:   Wed Feb 22 10:18:29 2012 +0800

    Replace createDirectoryHierarchy with createDirectoryIfMissing True
    
    createDirectoryHierarchy consisted of an existence test followed by
    createDirectory, which failed if that directory was creted just after
    the test. createDirectoryifMissing does not have this problem.

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

 compiler/iface/MkIface.lhs      |    3 ++-
 compiler/main/CodeOutput.lhs    |    3 +--
 compiler/main/DriverPipeline.hs |    6 +++---
 compiler/main/ErrUtils.lhs      |    3 ++-
 compiler/utils/Util.lhs         |   16 ++--------------
 5 files changed, 10 insertions(+), 21 deletions(-)

diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 32cb582..92e4e51 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -110,6 +110,7 @@ import Data.List
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.IORef
+import System.Directory
 import System.FilePath
 \end{code}
 
@@ -391,7 +392,7 @@ mkIface_ hsc_env maybe_old_fingerprint
 -----------------------------
 writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
 writeIfaceFile dflags location new_iface
-    = do createDirectoryHierarchy (takeDirectory hi_file_path)
+    = do createDirectoryIfMissing True (takeDirectory hi_file_path)
          writeBinIface dflags hi_file_path new_iface
     where hi_file_path = ml_hi_file location
 
diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs
index a9ab3f6..88ba0b5 100644
--- a/compiler/main/CodeOutput.lhs
+++ b/compiler/main/CodeOutput.lhs
@@ -17,7 +17,6 @@ import Finder           ( mkStubPaths )
 import PprC             ( writeCs )
 import CmmLint          ( cmmLint )
 import Packages
-import Util
 import OldCmm           ( RawCmmGroup )
 import HscTypes
 import DynFlags
@@ -190,7 +189,7 @@ outputForeignStubs dflags mod location stubs
             stub_h_output_w = showSDoc stub_h_output_d
         -- in
 
-        createDirectoryHierarchy (takeDirectory stub_h)
+        createDirectoryIfMissing True (takeDirectory stub_h)
 
         dumpIfSet_dyn dflags Opt_D_dump_foreign
                       "Foreign export header file" stub_h_output_d
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 16cd2c7..fab7600 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -1191,7 +1191,7 @@ runPhase As input_fn dflags
 
         -- we create directories for the object file, because it
         -- might be a hierarchical module.
-        io $ createDirectoryHierarchy (takeDirectory output_fn)
+        io $ createDirectoryIfMissing True (takeDirectory output_fn)
 
         io $ as_prog dflags
                        (map SysTools.Option as_opts
@@ -1230,7 +1230,7 @@ runPhase SplitAs _input_fn dflags
             osuf = objectSuf dflags
             split_odir  = base_o ++ "_" ++ osuf ++ "_split"
 
-        io $ createDirectoryHierarchy split_odir
+        io $ createDirectoryIfMissing True split_odir
 
         -- remove M_split/ *.o, because we're going to archive M_split/ *.o
         -- later and we don't want to pick up any old objects.
@@ -2137,6 +2137,6 @@ hscPostBackendPhase dflags _ hsc_lang =
 
 touchObjectFile :: DynFlags -> FilePath -> IO ()
 touchObjectFile dflags path = do
-  createDirectoryHierarchy $ takeDirectory path
+  createDirectoryIfMissing True $ takeDirectory path
   SysTools.touch dflags "Touching object file" path
 
diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs
index 52d05d0..be7f254 100644
--- a/compiler/main/ErrUtils.lhs
+++ b/compiler/main/ErrUtils.lhs
@@ -41,6 +41,7 @@ import SrcLoc
 import DynFlags
 import StaticFlags      ( opt_ErrorSpans )
 
+import System.Directory
 import System.Exit      ( ExitCode(..), exitWith )
 import System.FilePath
 import Data.List
@@ -236,7 +237,7 @@ dumpSDoc dflags dflag hdr doc
                             mode = if append then AppendMode else WriteMode
                         when (not append) $
                             writeIORef gdref (Set.insert fileName gd)
-                        createDirectoryHierarchy (takeDirectory fileName)
+                        createDirectoryIfMissing True (takeDirectory fileName)
                         handle <- openFile fileName mode
                         hPrintDump handle doc
                         hClose handle
diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs
index d09a1ad..12249d3 100644
--- a/compiler/utils/Util.lhs
+++ b/compiler/utils/Util.lhs
@@ -74,7 +74,6 @@ module Util (
         maybeRead, maybeReadFuzzy,
 
         -- * IO-ish utilities
-        createDirectoryHierarchy,
         doesDirNameExist,
         getModificationUTCTime,
         modificationTimeIfExists,
@@ -109,10 +108,9 @@ import Data.List        hiding (group)
 import FastTypes
 #endif
 
-import Control.Monad    ( unless, liftM )
+import Control.Monad    ( liftM )
 import System.IO.Error as IO ( isDoesNotExistError )
-import System.Directory ( doesDirectoryExist, createDirectory,
-                          getModificationTime )
+import System.Directory ( doesDirectoryExist, getModificationTime )
 import System.FilePath
 
 import Data.Char        ( isUpper, isAlphaNum, isSpace, chr, ord, isDigit )
@@ -1018,16 +1016,6 @@ maybeReadFuzzy str = case reads str of
                          Nothing
 
 -----------------------------------------------------------------------------
--- Create a hierarchy of directories
-
-createDirectoryHierarchy :: FilePath -> IO ()
-createDirectoryHierarchy dir | isDrive dir = return () -- XXX Hack
-createDirectoryHierarchy dir = do
-  b <- doesDirectoryExist dir
-  unless b $ do createDirectoryHierarchy (takeDirectory dir)
-                createDirectory dir
-
------------------------------------------------------------------------------
 -- Verify that the 'dirname' portion of a FilePath exists.
 --
 doesDirNameExist :: FilePath -> IO Bool