Cabal/src/Distribution/Compat/Process.hs

   1 {-# LANGUAGE CPP #-}
   2
   3 module Distribution.Compat.Process
   4   ( -- * Redefined functions
   5     proc
   6
   7     -- * Additions
   8   , enableProcessJobs
   9   ) where
  10
  11 import System.Process (CreateProcess)
  12 import qualified System.Process as Process
  13
  14 #if defined(mingw32_HOST_OS) && MIN_VERSION_process(1,6,9)
  15 import           System.IO.Unsafe (unsafePerformIO)
  16 import           System.Win32.Info.Version (dwMajorVersion, dwMinorVersion, getVersionEx)
  17 #endif
  18
  19 -------------------------------------------------------------------------------
  20 -- enableProcessJobs
  21 -------------------------------------------------------------------------------
  22
  23 #if defined(mingw32_HOST_OS) && MIN_VERSION_process(1,6,9)
  24 -- This exception, needed to support Windows 7, could be removed when
  25 -- the lowest GHC version cabal supports is a GHC that doesn’t support
  26 -- Windows 7 any more.
  27 {-# NOINLINE isWindows8OrLater #-}
  28 isWindows8OrLater :: Bool
  29 isWindows8OrLater = unsafePerformIO $ do
  30   v <- getVersionEx
  31   pure $ (dwMajorVersion v, dwMinorVersion v) >= (6, 2)
  32 #endif
  33
  34 -- | Enable process jobs to ensure accurate determination of process completion
  35 -- in the presence of @exec(3)@ on Windows.
  36 --
  37 -- Unfortunately the process job support is badly broken in @process@ releases
  38 -- prior to 1.6.9, so we disable it in these versions, despite the fact that
  39 -- this means we may see sporadic build failures without jobs.
  40 --
  41 -- On Windows 7 or before the jobs are disabled due to the fact that
  42 -- processes on these systems can only have one job. This prevents
  43 -- spawned process from assigning jobs to its own children. Suppose
  44 -- process A spawns process B. The B process has a job assigned (call
  45 -- it J1) and when it tries to spawn a new process C the C
  46 -- automatically inherits the job. But at it also tries to assign a
  47 -- new job J2 to C since it doesn’t have access J1. This fails on
  48 -- Windows 7 or before.
  49 enableProcessJobs :: CreateProcess -> CreateProcess
  50 #if defined(mingw32_HOST_OS) && MIN_VERSION_process(1,6,9)
  51 enableProcessJobs cp = cp {Process.use_process_jobs = isWindows8OrLater}
  52 #else
  53 enableProcessJobs cp = cp
  54 #endif
  55
  56 -------------------------------------------------------------------------------
  57 -- process redefinitions
  58 -------------------------------------------------------------------------------
  59
  60 -- | 'System.Process.proc' with process jobs enabled when appropriate,
  61 -- and defaulting 'delegate_ctlc' to 'True'.
  62 proc :: FilePath -> [String] -> CreateProcess
  63 proc path args = enableProcessJobs (Process.proc path args){Process.delegate_ctlc = True}