Commit 4c65964d authored by Tamar Christina's avatar Tamar Christina Committed by Ryan Scott

Fix nested temp calls with same base name (#30)

* Fix nested temp calls with same base name

* hsc2hs: split Windows and Linux temp file implementation.

* hsc2hs: Fix linux warnings

* hsc2hs: Add changelog entry and rename temp file template
parent b58b4e37
......@@ -8,13 +8,15 @@ import Data.List ( foldl' )
import System.IO
#if defined(mingw32_HOST_OS)
import Control.Concurrent ( threadDelay )
import Data.Bits ( xor )
import System.IO.Error ( isPermissionError )
import System.CPUTime ( getCPUTime )
import System.FilePath ( (</>) )
#endif
import System.Process ( createProcess, waitForProcess
, proc, CreateProcess(..), StdStream(..) )
import System.Exit ( ExitCode(..), exitWith )
import System.Directory ( removeFile )
import System.FilePath ( (</>) )
die :: String -> IO a
die s = hPutStr stderr s >> exitWith (ExitFailure 1)
......@@ -120,21 +122,47 @@ onlyOne what = die ("Only one "++what++" may be specified\n")
-- response file handling borrowed from cabal's at Distribution.Simple.Program.ResponseFile
withTempFile :: FilePath -- ^ Temp dir to create the file in
-> FilePath -- ^ Name of the hsc file being processed
-> FilePath -- ^ Name of the hsc file being processed or template
-> String -- ^ Template for temp file
-> Int -- ^ Random seed for tmp name
-> (FilePath -> Handle -> IO a) -> IO a
withTempFile tmpDir outBase action =
-- openTempFile isn't atomic under Windows until GHC 8.10. This means it's
-- unsuitable for use on Windows for creating random temp files. For hsc2hs
-- this doesn't matter much since hsc2hs is single threaded and always
-- finishes one part of its compilation pipeline before moving on to the next.
-- This means we can just use a deterministic file as a temp file. This file
-- will always be cleaned up before we move on to the next phase so we would
-- never get a clash. This follows the same pattern as in DirectCodegen.hs.
#if !defined(mingw32_HOST_OS)
withTempFile tmpDir _outBase template _seed action = do
Exception.bracket
(openTempFile tmpDir template)
(\(name, handle) -> do hClose handle
removeFile $ name)
(uncurry action)
#else
withTempFile tmpDir outBase template seed action = do
-- openTempFile isn't atomic under Windows. This means it's unsuitable for
-- use on Windows for creating random temp files. Instead we'll try to create
-- a reasonably random name based on the current outBase. If the
-- Sanity check to see that nothing invalidated this assumption is violated
-- then we retry a few times otherwise an error is raised.
rspFile <- findTmp 5
Exception.bracket
(openFile rspFile ReadWriteMode)
(\handle -> finallyRemove rspFile $ hClose handle)
(action rspFile)
where rspFile = tmpDir </> (outBase ++"_hsc_make.rsp")
where findTmp :: Int -> IO FilePath
findTmp 0 = die "Could not find unallocated temp file\n"
findTmp n = do
-- Generate a reasonable random number for token to prevent clashes if this
-- function is used recursively.
cpuTime <- getCPUTime
let token = show $ (fromIntegral seed) `xor` cpuTime
file = tmpDir </> (outBase ++ token ++ template)
-- Because of the resolution of the CPU timers there exists a small
-- possibility that multiple nested calls to withTempFile get the
-- same "token". To reduce the risk to almost zero we immediately
-- create the file to reserve it. If the file already exists we try
-- again.
res <- Exception.try $ openFile file ReadMode
case (res :: Either Exception.SomeException Handle) of
Left _ -> return file
Right h -> hClose h >> findTmp (n-1)
#endif
withResponseFile ::
FilePath -- ^ Working directory to create response file in.
......@@ -143,7 +171,7 @@ withResponseFile ::
-> (FilePath -> IO a)
-> IO a
withResponseFile workDir outBase arguments f =
withTempFile workDir outBase $ \responseFileName hf -> do
withTempFile workDir outBase "hsc2hscall.rsp" (length arguments) $ \responseFileName hf -> do
let responseContents = unlines $ map escapeResponseFileArg arguments
hPutStr hf responseContents
hClose hf
......
## 0.68.7
- Fix race condition when using response files (#30)
## 0.68.6
- Supports generation of response files to avoid system filepath
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment