Simon Hengel pushed to branch wip/sol/dont-use-global-variables at Glasgow Haskell Compiler / GHC Commits: 7d6e970a by Simon Hengel at 2026-05-06T01:55:17+07:00 Don't use global variables to address concurrency bugs! (fixes #27234) This was originally introduce with 88f38b03025386f0f1e8f5861eed67d80495168a to address #17922. In this specific case a better fix would have been to synchronize on stderr: withHandle_ "stderrSupportsAnsiColors" stderr $ \ _ -> do ... But apparently the dependency on `terminfo` was removed in 32ab07bf3d6ce45e8ea5b55e8095174a6b42a7f0, preventing #17922 in the first place. - - - - - 4 changed files: - + clean.sh - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/SysTools/Terminal.hs - libraries/ghc-internal/src/GHC/Internal/IO/Handle/Internals.hs Changes: ===================================== clean.sh ===================================== @@ -0,0 +1,28 @@ +#!/usr/bin/env bash + +set -o nounset +set -o errexit + +dst=$(git describe --tags | sed s/-release//) + +rm -rf "$dst" "$dst.tar.gz" + +mkdir -p "$dst" +find _build/stage1/ -name '*.hie' -print0 | xargs -0 cp --parents -t "$dst" + +rm -r "$dst/_build/stage1/utils/" +rm -r "$dst/_build/stage1/ghc/" + +mv "$dst/_build/stage1/compiler/build" "$dst/ghc" + +find "$dst/_build/" -type d -name build | while read -r dir +do + pkg=$(basename "$(dirname "$dir")") + mv "$dir" "$dst/$pkg" +done + +rm -r "$dst/_build/" + +tar -czvf "$dst.tar.gz" "$dst" + +rm -rf "$dst" ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -545,6 +545,7 @@ initDynFlags dflags = do `catchIOError` \_ -> return False ghcNoUnicodeEnv <- lookupEnv "GHC_NO_UNICODE" let useUnicode' = isNothing ghcNoUnicodeEnv && canUseUnicode + canUseColor <- stderrSupportsAnsiColors maybeGhcColorsEnv <- lookupEnv "GHC_COLORS" maybeGhcColoursEnv <- lookupEnv "GHC_COLOURS" let adjustCols (Just env) = Col.parseScheme env @@ -556,9 +557,9 @@ initDynFlags dflags = do return dflags{ useUnicode = useUnicode', useColor = useColor', - canUseColor = stderrSupportsAnsiColors, + canUseColor = canUseColor, -- if the terminal supports color, we assume it supports links as well - canUseErrorLinks = stderrSupportsAnsiColors, + canUseErrorLinks = canUseColor, colScheme = colScheme', tmpDir = TempDir tmp_dir } ===================================== compiler/GHC/SysTools/Terminal.hs ===================================== @@ -14,17 +14,9 @@ import qualified Graphics.Win32 as Win32 import qualified System.Win32 as Win32 #endif -import System.IO.Unsafe - --- | Does the controlling terminal support ANSI color sequences? --- This memoized to avoid thread-safety issues in ncurses (see #17922). -stderrSupportsAnsiColors :: Bool -stderrSupportsAnsiColors = unsafePerformIO stderrSupportsAnsiColors' -{-# NOINLINE stderrSupportsAnsiColors #-} - -- | Check if ANSI escape sequences can be used to control color in stderr. -stderrSupportsAnsiColors' :: IO Bool -stderrSupportsAnsiColors' = do +stderrSupportsAnsiColors :: IO Bool +stderrSupportsAnsiColors = do #if !defined(mingw32_HOST_OS) -- Equivalent of https://hackage.haskell.org/package/ansi-terminal/docs/System-Console-ANSI.h... isTerminal <- hIsTerminalDevice stderr ===================================== libraries/ghc-internal/src/GHC/Internal/IO/Handle/Internals.hs ===================================== @@ -143,8 +143,8 @@ original handle is always replaced. {-# INLINE withHandle #-} withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a -withHandle fun h@(FileHandle _ m) act = withHandle' fun h m act -withHandle fun h@(DuplexHandle _ m _) act = withHandle' fun h m act +withHandle fun h@(FileHandle _ m) = withHandle' fun h m +withHandle fun h@(DuplexHandle _ m _) = withHandle' fun h m withHandle' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO (Handle__,a)) -> IO a @@ -157,8 +157,8 @@ withHandle' fun h m act = {-# INLINE withHandle_ #-} withHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a -withHandle_ fun h@(FileHandle _ m) act = withHandle_' fun h m act -withHandle_ fun h@(DuplexHandle _ m _) act = withHandle_' fun h m act +withHandle_ fun h@(FileHandle _ m) = withHandle_' fun h m +withHandle_ fun h@(DuplexHandle _ m _) = withHandle_' fun h m withHandle_' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a withHandle_' fun h m act = withHandle' fun h m $ \h_ -> do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7d6e970a5905db346ef4851ed51e732d... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7d6e970a5905db346ef4851ed51e732d... You're receiving this email because of your account on gitlab.haskell.org.