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

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

proposed patch

  • compiler/iface/MkIface.lhs

    From b925a801cc38451ebdcd50889f0fb2cced9309bc Mon Sep 17 00:00:00 2001
    From: Takano Akio <[email protected]>
    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