Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8d49ed42 by Kazu Yamamoto at 2026-10-06T19:37:25-04:00 Do not leave standard file descriptors free at startup (#24450) A process may be started with stdout closed -- `prog >&-` from a shell does exactly that. Nothing then reserves descriptor 1, and open(), pipe() and socket() hand out the lowest free descriptor, so the next descriptor the runtime creates for itself takes it: the ticker's pipe, or a capability's IO manager control pipe. 'GHC.Internal.IO.StdHandles.stdout' is a CAF, built the first time the program writes to stdout, which is long after that has happened. It builds a 'Handle' over descriptor 1, which now belongs to the runtime, and nothing reports an error because the descriptor is perfectly good. The program then writes its output into the runtime's own plumbing. What that looks like from the outside is a hang. The descriptor the Handle has taken over is the read end of a pipe, so poll() for POLLOUT on it never says yes and epoll_ctl() accepts a registration for it; the thread waiting to write blocks for ever. Closing the Handle at exit closes the runtime's descriptor, which is worse: the ticker then fails on every tick. 'hs_init_ghc' now opens /dev/null onto whichever of descriptors 0, 1 and 2 are closed, before the runtime creates any descriptor of its own. Each is opened for the access that descriptor would normally have, read-only for 0 and write-only for 1 and 2, so that writing to 'stdin' or reading from 'stdout' still fails rather than quietly succeeding against /dev/null. See Note [Standard file descriptors must be open]. Moving only the descriptors the runtime opens would not do: the first file the program itself opened would land on the free number instead. The fix has to leave no free number. A program run this way therefore finds stdout connected to /dev/null rather than failing with EBADF on the first write, which is what such a program would get from most other language runtimes. Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com> - - - - - 65bcf9e9 by Simon Jakobi at 2026-10-06T19:38:09-04:00 changelog: Repair the sentence describing #27477 The description read "programs using could crash", the object of "using" having been lost. The synopsis already says which programs are affected, so drop the dangling word. Assisted-by: Claude Fable 5.1 - - - - - b9582136 by mangoiv at 2026-10-08T08:19:21-04:00 ci: move hadrian/ghci into the lint category so it can be picked up by more runners Fixes #27817 - - - - - a6722e24 by mangoiv at 2026-10-08T08:19:21-04:00 ci: make lint-adjacent jobs into platform independent - move lint jobs into lint-anyarch tag - unify lint jobs under the same platform independent container - - - - - 5f220362 by Zubin Duggal at 2026-10-08T08:19:22-04:00 DmdAnal: Make AbsDmd neutral in maxDmd fixes #27845 - - - - - 16 changed files: - .gitlab-ci.yml - + changelog.d/24450 - + changelog.d/27845 - changelog.d/fix-parallel-gc-selector-race-27477 - compiler/GHC/Types/Demand.hs - rts/RtsStartup.c - + testsuite/tests/dmdanal/should_run/T27845.hs - + testsuite/tests/dmdanal/should_run/T27845.stdout - + testsuite/tests/dmdanal/should_run/T27845_Lib.hs - + testsuite/tests/dmdanal/should_run/T27845b.hs - + testsuite/tests/dmdanal/should_run/T27845b.stdout - + testsuite/tests/dmdanal/should_run/T27845b_Lib.hs - testsuite/tests/dmdanal/should_run/all.T - + testsuite/tests/rts/T24450.hs - + testsuite/tests/rts/T24450.stderr - testsuite/tests/rts/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -137,15 +137,37 @@ workflow: .lint: stage: tool-lint tags: - - lint - before_script: - # Allow Git to read from the runner-owned checkout. This is needed - # for example by the lint-author job. - - git config --global --add safe.directory "$CI_PROJECT_DIR" + - lint-anyarch + image: debian:13 rules: - *drafts-can-fail-lint - when: always +.install-ghc-toolchain: &install-ghc-toolchain + - apt update + - apt install -qy build-essential curl libffi-dev libffi8 libgmp-dev libgmp10 libncurses-dev libncurses6 libtinfo6 pkg-config python3 cmake git happy alex autoconf automake python3 libgmp-dev libnuma-dev libncurses-dev + - curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh + - source /root/.ghcup/env + - ghcup --no-verbose install ghc --set --install-targets 'install_bin install_lib update_package_db' '9.10' + - ghcup --no-verbose install cabal --set + - ghc --info + - cabal --version + +# linting but we need a boot toolchain +.lint-ghc-toolchain: + extends: .lint + before_script: + - *install-ghc-toolchain + - git config --global --add safe.directory "$CI_PROJECT_DIR" + +# linting but we need python +.lint-python: + extends: .lint + before_script: + - apt update + - apt install -qy python3 mypy shellcheck git + - git config --global --add safe.directory "$CI_PROJECT_DIR" + .nightly: &nightly variables: XZ_OPT: "-9" @@ -217,11 +239,11 @@ not-interruptible: stage: not-interruptible script: "true" interruptible: false - image: "debian:13" + image: debian:13 variables: GIT_STRATEGY: none tags: - - lint + - lint-anyarch rules: # - if: '$CI_COMMIT_BRANCH == "master"' # when: always @@ -242,7 +264,6 @@ include: '.gitlab/jobs.yaml' ghc-linters: stage: tool-lint - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb13:$DOCKER_REV" extends: .lint-params variables: BUILD_FLAVOUR: default @@ -258,16 +279,11 @@ ghc-linters: # Skipped if the MR has the ~"no-changelog" label. lint-changelog: stage: tool-lint - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb13:$DOCKER_REV" - extends: .lint + extends: .lint-ghc-toolchain variables: CHANGELOG_EXPECT_MR: "$CI_MERGE_REQUEST_IID" GIT_DEPTH: 1 GIT_SUBMODULE_STRATEGY: none - before_script: - - export PATH="/opt/toolchain/bin:$PATH" - # workaround for docker permissions - - sudo chown ghc:ghc -R . script: - .gitlab/ci.sh lint_changelog dependencies: [] @@ -279,42 +295,30 @@ lint-changelog: # Run mypy Python typechecker on linter scripts. lint-linters: - image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" - extends: .lint + extends: .lint-python variables: GIT_DEPTH: 1 GIT_SUBMODULE_STRATEGY: none - before_script: - # workaround for docker permissions - - sudo chown ghc:ghc -R . script: - mypy testsuite/tests/linters/regex-linters/*.py dependencies: [] # Check that .T files all parse by listing broken tests. lint-testsuite: - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb13:$DOCKER_REV" - extends: .lint + extends: .lint-ghc-toolchain variables: GIT_DEPTH: 1 GIT_SUBMODULE_STRATEGY: none - before_script: - # workaround for docker permissions - - sudo chown ghc:ghc -R . script: - - make -Ctestsuite list_broken TEST_HC=$GHC + - make -Ctestsuite list_broken TEST_HC=$(which ghc) dependencies: [] # Run mypy Python typechecker on testsuite driver typecheck-testsuite: - image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" - extends: .lint + extends: .lint-python variables: GIT_DEPTH: 1 GIT_SUBMODULE_STRATEGY: none - before_script: - # workaround for docker permissions - - sudo chown ghc:ghc -R . script: - mypy testsuite/driver/runtests.py dependencies: [] @@ -323,7 +327,6 @@ typecheck-testsuite: # accommodate, e.g., haddock changes not yet upstream) but not on `master` or # Marge jobs. .lint-submods: - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb13:$DOCKER_REV" extends: .lint-params variables: BUILD_FLAVOUR: default @@ -341,13 +344,9 @@ typecheck-testsuite: # Check that commits in an MR were not authored with the identity that CI uses # when it needs to create commits itself. This only needs Git history. lint-author: - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb13:$DOCKER_REV" - extends: .lint + extends: .lint-python variables: GIT_SUBMODULE_STRATEGY: none - before_script: - # workaround for docker permissions - - sudo chown ghc:ghc -R . script: - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" @@ -425,12 +424,9 @@ lint-submods-branch: .lint-params: needs: [] - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb13:$DOCKER_REV" extends: .lint before_script: - - export PATH="/opt/toolchain/bin:$PATH" - # workaround for docker permissions - - sudo chown ghc:ghc -R . + - *install-ghc-toolchain - .gitlab/ci.sh setup after_script: - .gitlab/ci.sh save_cache @@ -448,18 +444,13 @@ lint-submods-branch: hadrian-ghc-in-ghci: stage: quick-build + extends: .lint-ghc-toolchain needs: - job: lint-linters - job: lint-submods optional: true - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb13:$DOCKER_REV" - before_script: - # workaround for docker permissions - - sudo chown ghc:ghc -R . variables: GHC_FLAGS: -Werror -Wwarn=unused-imports - tags: - - x86_64-linux script: - git clean -xdf && git submodule foreach git clean -xdf - . .gitlab/ci.sh setup @@ -544,6 +535,7 @@ stack-hadrian-build: extends: hadrian-ghc-in-ghci stage: quick-build script: + - ghcup --no-verbose install stack --set - . .gitlab/ci.sh setup - . .gitlab/ci.sh configure - hadrian/build-stack --version ===================================== changelog.d/24450 ===================================== @@ -0,0 +1,14 @@ +section: rts +synopsis: + Fix a hang when a program is started with a standard file descriptor closed +description: + A process started with stdout or stderr closed -- ``prog >&-`` from a shell + does exactly that -- left that descriptor number free for the runtime to + take for its own use. The ``Handle`` for the stream, built later when the + program first wrote to it, then took over a descriptor belonging to the + runtime: the program wrote its output into the runtime's own plumbing and + hung, with no error reported anywhere. The runtime now opens ``/dev/null`` + onto whichever of the descriptors 0, 1 and 2 are closed when it starts, so + such a stream is connected to ``/dev/null`` instead. +mrs: !16710 +issues: #24450 ===================================== changelog.d/27845 ===================================== @@ -0,0 +1,5 @@ +section: compiler +synopsis: Fix a bug where an argument used lazily only by a function's stable + unfolding could be treated as strict in its fields. +mrs: !16746 +issues: #27845 ===================================== changelog.d/fix-parallel-gc-selector-race-27477 ===================================== @@ -1,7 +1,7 @@ section: rts synopsis: Fix a parallel GC race on weakly-ordered architectures (AArch64) that could crash or silently corrupt the heap description: - On weakly-ordered architectures such as AArch64 programs using + On weakly-ordered architectures such as AArch64, programs could crash during parallel garbage collection (segmentation fault or ``internal error: eval_thunk_selector: strange selectee <n>``) or continue running with silently corrupted heap data, due to a missing ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -924,6 +924,8 @@ maxCard (Card a) (Card b) = Card ((a .&. b .&. 0b001) .|. ((a .|. b) .&. 0b110)) maxDmd :: Demand -> Demand -> Demand maxDmd BotDmd dmd2 = dmd2 maxDmd dmd1 BotDmd = dmd1 +maxDmd AbsDmd dmd2 = dmd2 +maxDmd dmd1 AbsDmd = dmd1 maxDmd (n1 :* sd1) (n2 :* sd2) = maxCard n1 n2 :* maxSubDmd sd1 sd2 ===================================== rts/RtsStartup.c ===================================== @@ -69,6 +69,10 @@ #if defined(HAVE_LOCALE_H) #include <locale.h> #endif +#if !defined(mingw32_HOST_OS) +#include <errno.h> +#include <fcntl.h> +#endif // Count of how many outstanding hs_init()s there have been. static StgWord hs_init_count = 0; @@ -81,6 +85,10 @@ static int64_t __codePage = -1; static void flushStdHandles(void); +#if !defined(mingw32_HOST_OS) +static void sanitiseStandardFds(void); +#endif + /* ----------------------------------------------------------------------------- Initialise floating point unit on x86 (currently disabled; See Note [x86 Floating point precision] in compiler/GHC/CmmToAsm/X86/Instr.hs) @@ -238,6 +246,82 @@ hs_init_with_rtsopts(int *argc, char **argv[]) void init_ghc_hs_iface(void); +#if !defined(mingw32_HOST_OS) +/* See Note [Standard file descriptors must be open]. */ +static void sanitiseStandardFds(void) +{ + // The access mode each descriptor would have had, had the process been + // started with it open. + static const int access_mode[3] = { O_RDONLY, O_WRONLY, O_WRONLY }; + + for (int fd = 0; fd <= 2; fd++) { + if (fcntl(fd, F_GETFD) != -1 || errno != EBADF) { + continue; // already open + } + + int nullfd; + do { + nullfd = open("/dev/null", access_mode[fd]); + } while (nullfd == -1 && errno == EINTR); + + if (nullfd == -1) { + // No /dev/null to be had. There is nothing better to do than + // carry on; the hazard the Note describes is then still there, + // but refusing to start would be worse. + return; + } + if (nullfd != fd) { + // open() hands out the lowest free descriptor, so this cannot + // happen unless something in this process is opening descriptors + // concurrently. Do not shuffle its descriptor around. + close(nullfd); + return; + } + } +} + +/* + * Note [Standard file descriptors must be open] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * A process may be started with any of file descriptors 0, 1 and 2 closed -- + * from a shell, `prog >&-` does exactly that. Nothing then reserves those + * numbers, and open(), pipe() and socket() hand out the lowest free + * descriptor, so the next descriptor the runtime creates for itself takes one + * of them: the ticker's pipe, or a capability's IO manager control pipe. + * + * Nothing warns anybody. 'GHC.Internal.IO.StdHandles.stdout' is a CAF, so it + * is built the first time the program writes to stdout, which is long after + * that has happened, and it builds a 'Handle' over descriptor 1 -- which now + * belongs to the runtime. The program then writes its output into the + * runtime's own plumbing, and at exit closes it. + * + * What this looks like from the outside is a hang, because the descriptor the + * Handle has taken over is the read end of a pipe. It is a perfectly good + * descriptor, so nothing reports an error: poll() for POLLOUT on it simply + * never says yes, epoll_ctl() accepts a registration for it, and the thread + * waiting to write blocks for ever. See #24450, where this is `prog >&-` + * hanging after main has finished. + * + * Closing those descriptors is legal, so the runtime cannot refuse them; and + * moving only the descriptors the runtime opens would not help, since the + * first file the program itself opens would land on the free number instead. + * The fix is to leave no free number: open /dev/null onto whichever of 0, 1 + * and 2 are closed, before the runtime creates any descriptor of its own. + * Other runtimes do the same, and for the same reason. + * + * A program run this way therefore finds stdout connected to /dev/null rather + * than failing with EBADF on the first write. That is the price of the fix, + * and it is the behaviour such a program would get from most other language + * runtimes. + * + * Each substitute is opened for the access the descriptor would normally have: + * read-only for 0, write-only for 1 and 2. Opening all three for both would + * make the substitute something a real stdin or stdout is not, and writing to + * 'stdin' or reading from 'stdout' would then quietly succeed instead of + * failing with EBADF. + */ +#endif + void hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) { @@ -252,6 +336,12 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) stg_exit(1); } +#if !defined(mingw32_HOST_OS) + /* Before anything here opens a file descriptor of its own. + See Note [Standard file descriptors must be open]. */ + sanitiseStandardFds(); +#endif + #if defined(wasm32_HOST_ARCH) char *pwd = getenv("PWD"); if (pwd != NULL) { ===================================== testsuite/tests/dmdanal/should_run/T27845.hs ===================================== @@ -0,0 +1,14 @@ +module Main where +import T27845_Lib (f) +import System.Environment (getArgs) + +{-# NOINLINE mkArg #-} +mkArg :: Int -> Int +mkArg n | n < 0 = n + | otherwise = error ("boom " ++ show n) + +main :: IO () +main = do + n <- length <$> getArgs + let x = mkArg n + print (length (f (x, x) n)) ===================================== testsuite/tests/dmdanal/should_run/T27845.stdout ===================================== @@ -0,0 +1 @@ +0 ===================================== testsuite/tests/dmdanal/should_run/T27845_Lib.hs ===================================== @@ -0,0 +1,11 @@ +module T27845_Lib where + +{-# INLINABLE [2] f #-} +f :: a -> Int -> [a] +f p x = lazyUse p x ++ lazyUse p (x + 1) ++ lazyUse p (x + 2) + +{-# NOINLINE lazyUse #-} +lazyUse :: a -> Int -> [a] +lazyUse p x = p `seq` replicate x p + +{-# RULES "lazyUse" [1] forall p x. lazyUse p x = [] #-} ===================================== testsuite/tests/dmdanal/should_run/T27845b.hs ===================================== @@ -0,0 +1,14 @@ +module Main where +import T27845b_Lib (outer) +import System.Environment (getArgs) + +{-# NOINLINE mkArg #-} +mkArg :: Int -> Int +mkArg n | n < 0 = n + | otherwise = error ("boom " ++ show n) + +main :: IO () +main = do + n <- length <$> getArgs + let x = mkArg n + print (length (outer (x, x) n)) ===================================== testsuite/tests/dmdanal/should_run/T27845b.stdout ===================================== @@ -0,0 +1 @@ +0 ===================================== testsuite/tests/dmdanal/should_run/T27845b_Lib.hs ===================================== @@ -0,0 +1,14 @@ +module T27845b_Lib where + +outer :: a -> Int -> [a] +outer a n = + let {-# INLINABLE [2] g #-} + g x = lazyUse a (x + 0) ++ lazyUse a (x + 1) ++ lazyUse a (x + 2) + in g n ++ g (n + 1) ++ g (n + 2) +{-# NOINLINE outer #-} + +{-# NOINLINE lazyUse #-} +lazyUse :: a -> Int -> [a] +lazyUse p x = p `seq` replicate x p + +{-# RULES "lazyUse" [1] forall p x. lazyUse p x = [] #-} ===================================== testsuite/tests/dmdanal/should_run/all.T ===================================== @@ -37,3 +37,5 @@ test('T25439', normal, compile_and_run, ['']) test('T26748', normal, compile_and_run, ['']) test('T26416', [extra_files(['M1.hs'])], multimod_compile_and_run, ['T26416','M1.hs']) test('T27626', [extra_files(['M2.hs'])], multimod_compile_and_run, ['T27626','M2.hs']) +test('T27845', [extra_files(['T27845_Lib.hs'])], multimod_compile_and_run, ['T27845','T27845_Lib.hs']) +test('T27845b', [extra_files(['T27845b_Lib.hs'])], multimod_compile_and_run, ['T27845b','T27845b_Lib.hs']) ===================================== testsuite/tests/rts/T24450.hs ===================================== @@ -0,0 +1,41 @@ +{-# LANGUAGE ScopedTypeVariables #-} +-- A process may be started with stdout closed -- `prog >&-` from a shell does +-- exactly that. Nothing then reserves descriptor 1, so the next descriptor +-- the runtime opens for itself takes it, and the 'Handle' for stdout, built +-- later when the program first writes, takes over a descriptor belonging to +-- the runtime. The write then goes into the runtime's own plumbing, and what +-- this looks like from the outside is a hang. See #24450 and +-- Note [Standard file descriptors must be open] in rts/RtsStartup.c. +-- +-- This test is run with its stdin and stdout closed, so what it has to say +-- goes to stderr. The four writes are the reproducer from the ticket and must +-- simply finish. The lines after them are what tell the two outcomes apart: +-- the descriptors the runtime opens for itself are pipes, so finding a pipe on +-- descriptor 0 or 1 means it was handed to the runtime. +module Main (main) where + +import Control.Exception (IOException, try) +import System.IO +import System.Posix.Files (getFdStatus, isCharacterDevice, isNamedPipe) +import System.Posix.Types (Fd (..)) + +main :: IO () +main = do + hPutChar stderr 'A' -- unbuffered + hPutChar stdout 'X' -- buffered; this is the one that used to hang + hPutChar stderr 'Z' -- unbuffered + hPutChar stderr '\n' -- unbuffered + mapM_ (\fd -> hPutStrLn stderr =<< describeFd fd) [0, 1] + +describeFd :: Fd -> IO String +describeFd fd = do + r <- try (getFdStatus fd) + return $ "fd " ++ show fd ++ ": " ++ case r of + Left (_ :: IOException) -> "closed" + Right st + -- What the fix arranges: /dev/null, opened onto the free number + -- before the runtime could take it. + | isCharacterDevice st -> "character device" + -- What #24450 is: the runtime's ticker or control pipe. + | isNamedPipe st -> "pipe" + | otherwise -> "something else" ===================================== testsuite/tests/rts/T24450.stderr ===================================== @@ -0,0 +1,3 @@ +AZ +fd 0: character device +fd 1: character device ===================================== testsuite/tests/rts/all.T ===================================== @@ -408,6 +408,18 @@ test('T10590', [ ignore_stderr , req_process ], compile_and_run, ['']) +# Run with stdin and stdout closed -- that is what leaves those descriptors +# free for the runtime to take, which is the whole of #24450. What the test +# has to say therefore goes to stderr and is checked against T24450.stderr. +test('T24450', + [ when(opsys('mingw32'), skip) # POSIX only + , js_skip # JS backend has its own runtime + # The wrapper below would close the stdout of the wasm runtime rather + # than that of the program running under it, which tests nothing. + , when(arch('wasm32'), skip) + , cmd_wrapper(lambda c: c + ' <&- >&-') + ], compile_and_run, ['']) + # 20000 was easily enough to trigger the bug with 7.10 test('T10904', [ extra_run_opts('20000'), req_c ], compile_and_run, ['T10904lib.c']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f20e7d949c703152133e0c6147073aa... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f20e7d949c703152133e0c6147073aa... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help