Ticket #5891: 0001-Replace-createDirectoryHierarchy-with-createDirector.patch

File 0001-Replace-createDirectoryHierarchy-with-createDirector.patch, 5.9 KB (added by akio, 2 years ago)

proposed patch

  • compiler/iface/MkIface.lhs

    From b925a801cc38451ebdcd50889f0fb2cced9309bc Mon Sep 17 00:00:00 2001
    From: Takano Akio <aljee@hyper.cx>
    Date: Wed, 22 Feb 2012 10:18:29 +0800
    Subject: [PATCH] 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 9290a68..e12ebb3 100644
    a b import Data.List 
    110110import Data.Map (Map) 
    111111import qualified Data.Map as Map 
    112112import Data.IORef 
     113import System.Directory 
    113114import System.FilePath 
    114115\end{code} 
    115116 
    mkIface_ hsc_env maybe_old_fingerprint 
    391392----------------------------- 
    392393writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO () 
    393394writeIfaceFile dflags location new_iface 
    394     = do createDirectoryHierarchy (takeDirectory hi_file_path) 
     395    = do createDirectoryIfMissing True (takeDirectory hi_file_path) 
    395396         writeBinIface dflags hi_file_path new_iface 
    396397    where hi_file_path = ml_hi_file location 
    397398 
  • compiler/main/CodeOutput.lhs

    diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs
    index a9ab3f6..88ba0b5 100644
    a b import Finder ( mkStubPaths ) 
    1717import PprC             ( writeCs ) 
    1818import CmmLint          ( cmmLint ) 
    1919import Packages 
    20 import Util 
    2120import OldCmm           ( RawCmmGroup ) 
    2221import HscTypes 
    2322import DynFlags 
    outputForeignStubs dflags mod location stubs 
    190189            stub_h_output_w = showSDoc stub_h_output_d 
    191190        -- in 
    192191 
    193         createDirectoryHierarchy (takeDirectory stub_h) 
     192        createDirectoryIfMissing True (takeDirectory stub_h) 
    194193 
    195194        dumpIfSet_dyn dflags Opt_D_dump_foreign 
    196195                      "Foreign export header file" stub_h_output_d 
  • compiler/main/DriverPipeline.hs

    diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
    index 16cd2c7..fab7600 100644
    a b runPhase As input_fn dflags 
    11911191 
    11921192        -- we create directories for the object file, because it 
    11931193        -- might be a hierarchical module. 
    1194         io $ createDirectoryHierarchy (takeDirectory output_fn) 
     1194        io $ createDirectoryIfMissing True (takeDirectory output_fn) 
    11951195 
    11961196        io $ as_prog dflags 
    11971197                       (map SysTools.Option as_opts 
    runPhase SplitAs _input_fn dflags 
    12301230            osuf = objectSuf dflags 
    12311231            split_odir  = base_o ++ "_" ++ osuf ++ "_split" 
    12321232 
    1233         io $ createDirectoryHierarchy split_odir 
     1233        io $ createDirectoryIfMissing True split_odir 
    12341234 
    12351235        -- remove M_split/ *.o, because we're going to archive M_split/ *.o 
    12361236        -- later and we don't want to pick up any old objects. 
    hscPostBackendPhase dflags _ hsc_lang = 
    21372137 
    21382138touchObjectFile :: DynFlags -> FilePath -> IO () 
    21392139touchObjectFile dflags path = do 
    2140   createDirectoryHierarchy $ takeDirectory path 
     2140  createDirectoryIfMissing True $ takeDirectory path 
    21412141  SysTools.touch dflags "Touching object file" path 
    21422142 
  • compiler/main/ErrUtils.lhs

    diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs
    index 6ba9df4..fe3de1d 100644
    a b import SrcLoc 
    4141import DynFlags 
    4242import StaticFlags      ( opt_ErrorSpans ) 
    4343 
     44import System.Directory 
    4445import System.Exit      ( ExitCode(..), exitWith ) 
    4546import System.FilePath 
    4647import Data.List 
    dumpSDoc dflags dflag hdr doc 
    239240                            mode = if append then AppendMode else WriteMode 
    240241                        when (not append) $ 
    241242                            writeIORef gdref (Set.insert fileName gd) 
    242                         createDirectoryHierarchy (takeDirectory fileName) 
     243                        createDirectoryIfMissing True (takeDirectory fileName) 
    243244                        handle <- openFile fileName mode 
    244245                        hPrintDump handle doc 
    245246                        hClose handle 
  • compiler/utils/Util.lhs

    diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs
    index d09a1ad..12249d3 100644
    a b module Util ( 
    7474        maybeRead, maybeReadFuzzy, 
    7575 
    7676        -- * IO-ish utilities 
    77         createDirectoryHierarchy, 
    7877        doesDirNameExist, 
    7978        getModificationUTCTime, 
    8079        modificationTimeIfExists, 
    import Data.List hiding (group) 
    109108import FastTypes 
    110109#endif 
    111110 
    112 import Control.Monad    ( unless, liftM ) 
     111import Control.Monad    ( liftM ) 
    113112import System.IO.Error as IO ( isDoesNotExistError ) 
    114 import System.Directory ( doesDirectoryExist, createDirectory, 
    115                           getModificationTime ) 
     113import System.Directory ( doesDirectoryExist, getModificationTime ) 
    116114import System.FilePath 
    117115 
    118116import Data.Char        ( isUpper, isAlphaNum, isSpace, chr, ord, isDigit ) 
    maybeReadFuzzy str = case reads str of 
    10181016                         Nothing 
    10191017 
    10201018----------------------------------------------------------------------------- 
    1021 -- Create a hierarchy of directories 
    1022  
    1023 createDirectoryHierarchy :: FilePath -> IO () 
    1024 createDirectoryHierarchy dir | isDrive dir = return () -- XXX Hack 
    1025 createDirectoryHierarchy dir = do 
    1026   b <- doesDirectoryExist dir 
    1027   unless b $ do createDirectoryHierarchy (takeDirectory dir) 
    1028                 createDirectory dir 
    1029  
    1030 ----------------------------------------------------------------------------- 
    10311019-- Verify that the 'dirname' portion of a FilePath exists. 
    10321020-- 
    10331021doesDirNameExist :: FilePath -> IO Bool