[Git][ghc/ghc][wip/backports-9.4] 15 commits: make: Add another missing build dependency on template-haskell
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Mon Aug 15 21:11:41 UTC 2022
Ben Gamari pushed to branch wip/backports-9.4 at Glasgow Haskell Compiler / GHC
Commits:
05eef6e2 by Ben Gamari at 2022-08-15T17:03:18-04:00
make: Add another missing build dependency on template-haskell
This time the culprit is Data.Sequence.Internal.
Closes #22047.
- - - - -
c2043b0a by normalcoder at 2022-08-15T17:11:26-04:00
ncg/aarch64: Don't use x18 register on AArch64/Darwin
Apple's ABI documentation [1] says: "The platforms reserve register x18.
Don’t use this register." While this wasn't problematic in previous
Darwin releases, macOS 13 appears to start zeroing this register
periodically. See #21964.
[1] https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms
(cherry picked from commit 67575f2004340564d6e52af055ed6fb43d3f9711)
- - - - -
44b60e03 by Ben Gamari at 2022-08-15T17:11:26-04:00
gitlab-ci: Don't use coreutils on Darwin
In general we want to ensure that the tested environment is as similar
as possible to the environment the user will use. In the case of Darwin,
this means we want to use the system's BSD command-line utilities, not
coreutils.
This would have caught #21974.
(cherry picked from commit c1c08bd829fb33a185f0a71f08babe5d7e6556fc)
- - - - -
658d3fd5 by Ben Gamari at 2022-08-15T17:11:26-04:00
hadrian: Fix bindist installation on Darwin
It turns out that `cp -P` on Darwin does not always copy a symlink as
a symlink. In order to get these semantics one must pass `-RP`. It's not
entirely clear whether this is valid under POSIX, but it is nevertheless
what Apple does.
(cherry picked from commit 1c582f44e41f534a8506a76618f6cffe5d71ed42)
- - - - -
e2832cbd by Ben Gamari at 2022-08-15T17:11:26-04:00
hadrian: Fix access mode of installed package registration files
Previously hadrian's bindist Makefile would modify package
registrations placed by `install` via a shell pipeline and `mv`.
However, the use of `mv` means that if umask is set then the user may
otherwise end up with package registrations which are inaccessible.
Fix this by ensuring that the mode is 0644.
(cherry picked from commit 681aa076259c05c626266cf516de7e7c5524eadb)
- - - - -
cdf69083 by Ben Gamari at 2022-08-15T17:11:26-04:00
rts/linker: Resolve iconv_* on FreeBSD
FreeBSD's libiconv includes an implementation of the
iconv_* functions in libc. Unfortunately these can
only be resolved using dlvsym, which is how the RTS linker
usually resolves such functions. To fix this we include an ad-hoc
special case for iconv_*.
Fixes #20354.
(cherry picked from commit 844df61e8de5e2d9a058e6cbe388802755fc0305)
(cherry picked from commit d8961a2dc974b7f8f8752781c4aec261ae8f8c0f)
- - - - -
4f1e1a30 by Ben Gamari at 2022-08-15T17:11:26-04:00
system-cxx-std-lib: Add support for FreeBSD libcxxrt
(cherry picked from commit 5d66a0ce39f47b7b9f6c732a18ac6e102a21ee6b)
- - - - -
573569d5 by Ben Gamari at 2022-08-15T17:11:26-04:00
gitlab-ci: Bump to use freebsd13 runners
(cherry picked from commit ea90e61dc3c6ba0433e008284dc6c3970ead98a7)
- - - - -
12244700 by Douglas Wilson at 2022-08-15T17:11:26-04:00
testsuite: 21651 add test for closeFdWith + setNumCapabilities
This bug does not affect windows, which does not use the
base module GHC.Event.Thread.
(cherry picked from commit 76b52cf0c52ee05c20f7d1b80f5600eecab3c42a)
- - - - -
feceab56 by Douglas Wilson at 2022-08-15T17:11:26-04:00
base: Fix races in IOManager (setNumCapabilities,closeFdWith)
Fix for #21651
Fixes three bugs:
- writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith.
- The race in closeFdWith described in the ticket.
- A race in getSystemEventManager where it accesses the 'IOArray' in
'eventManager' before 'ioManagerCapabilitiesChanged' has written to
'eventManager', causing an Array Index exception. The fix here is to
'yield' and retry.
(cherry picked from commit 7589ee7241d46b393979d98d4ded17a15ee974fb)
- - - - -
088071e5 by Jens Petersen at 2022-08-15T17:11:26-04:00
hadrian RunRest: add type signature for stageNumber
avoids warning seen on 9.4.1:
src/Settings/Builders/RunTest.hs:264:53: warning: [-Wtype-defaults]
• Defaulting the following constraints to type ‘Integer’
(Show a0)
arising from a use of ‘show’
at src/Settings/Builders/RunTest.hs:264:53-84
(Num a0)
arising from a use of ‘stageNumber’
at src/Settings/Builders/RunTest.hs:264:59-83
• In the second argument of ‘(++)’, namely
‘show (stageNumber (C.stage ctx))’
In the second argument of ‘($)’, namely
‘"config.stage=" ++ show (stageNumber (C.stage ctx))’
In the expression:
arg $ "config.stage=" ++ show (stageNumber (C.stage ctx))
|
264 | , arg "-e", arg $ "config.stage=" ++ show (stageNumber (C.stage ctx))
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
compilation tested locally
(cherry picked from commit 823fe5b56450a7eefbf41ce8ece34095bf2217ee)
- - - - -
f7322f2a by Ben Gamari at 2022-08-15T17:11:26-04:00
hadrian: Don't attempt to install documentation if doc/ doesn't exist
Previously we would attempt to install documentation even if the `doc`
directory doesn't exist (e.g. due to `--docs=none`). This would result
in the surprising side-effect of the entire contents of the bindist
being installed in the destination documentation directory. Fix this.
Fixes #21976.
(cherry picked from commit 7cabea7c9b10d2d15a4798be9f3130994393dd9c)
- - - - -
a77c7462 by Ben Gamari at 2022-08-15T17:11:26-04:00
relnotes: Fix typo
- - - - -
d87e0545 by Matthew Pickering at 2022-08-15T17:11:27-04:00
driver: Don't create LinkNodes when -no-link is enabled
Fixes #21866
(cherry picked from commit ef30e21594e44af309c627052f63aea6fd575c9e)
- - - - -
0bea62ff by Ben Gamari at 2022-08-15T17:11:27-04:00
base: Add changelog entries from ghc-9.2
Closes #21922.
- - - - -
27 changed files:
- .gitlab/ci.sh
- .gitlab/darwin/toolchain.nix
- .gitlab/gen_ci.hs
- .gitlab/jobs.yaml
- compiler/CodeGen.Platform.h
- compiler/GHC/Driver/Make.hs
- docs/users_guide/9.4.1-notes.rst
- ghc.mk
- hadrian/bindist/Makefile
- hadrian/src/Rules/BinaryDist.hs
- hadrian/src/Settings/Builders/RunTest.hs
- libraries/base/GHC/Event/Thread.hs
- libraries/base/changelog.md
- m4/fp_find_cxx_std_lib.m4
- + mk/install_script.sh
- rts/Linker.c
- + testsuite/tests/concurrent/should_run/T21651.hs
- + testsuite/tests/concurrent/should_run/T21651.stdout
- testsuite/tests/concurrent/should_run/all.T
- testsuite/tests/driver/T20316.stdout
- + testsuite/tests/driver/T21866.hs
- + testsuite/tests/driver/T21866.stderr
- testsuite/tests/driver/all.T
- testsuite/tests/driver/recomp007/recomp007.stdout
- testsuite/tests/driver/retc001/retc001.stdout
- testsuite/tests/indexed-types/should_compile/impexp.stderr
- testsuite/tests/typecheck/should_fail/T6018fail.stderr
Changes:
=====================================
.gitlab/ci.sh
=====================================
@@ -206,6 +206,9 @@ function set_toolchain_paths() {
CABAL="$toolchain/bin/cabal$exe"
HAPPY="$toolchain/bin/happy$exe"
ALEX="$toolchain/bin/alex$exe"
+ if [ "$(uname)" = "FreeBSD" ]; then
+ GHC=/usr/local/bin/ghc
+ fi
;;
nix)
if [[ ! -f toolchain.sh ]]; then
@@ -287,7 +290,7 @@ function fetch_ghc() {
cp -r ghc-${GHC_VERSION}*/* "$toolchain"
;;
*)
- pushd "ghc-${GHC_VERSION}*"
+ pushd ghc-${GHC_VERSION}*
./configure --prefix="$toolchain"
"$MAKE" install
popd
@@ -325,9 +328,7 @@ function fetch_cabal() {
local base_url="https://downloads.haskell.org/~cabal/cabal-install-$v/"
case "$(uname)" in
Darwin) cabal_url="$base_url/cabal-install-$v-x86_64-apple-darwin17.7.0.tar.xz" ;;
- FreeBSD)
- #cabal_url="$base_url/cabal-install-$v-x86_64-portbld-freebsd.tar.xz" ;;
- cabal_url="http://home.smart-cactus.org/~ben/ghc/cabal-install-3.0.0.0-x86_64-portbld-freebsd.tar.xz" ;;
+ FreeBSD) cabal_url="$base_url/cabal-install-$v-x86_64-freebsd13.tar.xz" ;;
*) fail "don't know where to fetch cabal-install for $(uname)"
esac
echo "Fetching cabal-install from $cabal_url"
=====================================
.gitlab/darwin/toolchain.nix
=====================================
@@ -85,7 +85,6 @@ pkgs.writeTextFile {
export PATH
PATH="${pkgs.autoconf}/bin:$PATH"
PATH="${pkgs.automake}/bin:$PATH"
- PATH="${pkgs.coreutils}/bin:$PATH"
export FONTCONFIG_FILE=${fonts}
export XELATEX="${ourtexlive}/bin/xelatex"
export MAKEINDEX="${ourtexlive}/bin/makeindex"
=====================================
.gitlab/gen_ci.hs
=====================================
@@ -92,7 +92,7 @@ names of jobs to update these other places.
data Opsys
= Linux LinuxDistro
| Darwin
- | FreeBSD
+ | FreeBSD13
| Windows deriving (Eq)
data LinuxDistro
@@ -210,7 +210,7 @@ runnerTag arch (Linux distro) =
runnerTag AArch64 Darwin = "aarch64-darwin"
runnerTag Amd64 Darwin = "x86_64-darwin-m1"
runnerTag Amd64 Windows = "new-x86_64-windows"
-runnerTag Amd64 FreeBSD = "x86_64-freebsd"
+runnerTag Amd64 FreeBSD13 = "x86_64-freebsd13"
tags :: Arch -> Opsys -> BuildConfig -> [String]
tags arch opsys _bc = [runnerTag arch opsys] -- Tag for which runners we can use
@@ -229,7 +229,7 @@ distroName Alpine = "alpine3_12"
opsysName :: Opsys -> String
opsysName (Linux distro) = "linux-" ++ distroName distro
opsysName Darwin = "darwin"
-opsysName FreeBSD = "freebsd"
+opsysName FreeBSD13 = "freebsd13"
opsysName Windows = "windows"
archName :: Arch -> String
@@ -299,7 +299,7 @@ type Variables = M.MonoidalMap String [String]
a =: b = M.singleton a [b]
opsysVariables :: Arch -> Opsys -> Variables
-opsysVariables _ FreeBSD = mconcat
+opsysVariables _ FreeBSD13 = mconcat
[ -- N.B. we use iconv from ports as I see linker errors when we attempt
-- to use the "native" iconv embedded in libc as suggested by the
-- porting guide [1].
@@ -307,7 +307,7 @@ opsysVariables _ FreeBSD = mconcat
"CONFIGURE_ARGS" =: "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib"
, "HADRIAN_ARGS" =: "--docs=no-sphinx"
, "GHC_VERSION" =: "9.2.2"
- , "CABAL_INSTALL_VERSION" =: "3.2.0.0"
+ , "CABAL_INSTALL_VERSION" =: "3.6.2.0"
]
opsysVariables ARMv7 (Linux distro) =
distroVariables distro <>
@@ -475,12 +475,12 @@ instance ToJSON OnOffRules where
-- | A Rule corresponds to some condition which must be satisifed in order to
-- run the job.
-data Rule = FastCI -- ^ Run this job when the fast-ci label is set
- | ReleaseOnly -- ^ Only run this job in a release pipeline
- | Nightly -- ^ Only run this job in the nightly pipeline
- | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present
- | FreeBSDTag -- ^ Only run this job when the "FreeBSD" label is set.
- | Disable -- ^ Don't run this job.
+data Rule = FastCI -- ^ Run this job when the fast-ci label is set
+ | ReleaseOnly -- ^ Only run this job in a release pipeline
+ | Nightly -- ^ Only run this job in the nightly pipeline
+ | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present
+ | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set.
+ | Disable -- ^ Don't run this job.
deriving (Bounded, Enum, Ord, Eq)
-- A constant evaluating to True because gitlab doesn't support "true" in the
@@ -498,8 +498,8 @@ ruleString On FastCI = true
ruleString Off FastCI = "$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/"
ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/"
ruleString Off LLVMBackend = true
-ruleString On FreeBSDTag = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/"
-ruleString Off FreeBSDTag = true
+ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/"
+ruleString Off FreeBSDLabel = true
ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\""
ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\""
ruleString On Nightly = "$NIGHTLY"
@@ -766,7 +766,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $
, fastCI (standardBuilds Amd64 Windows)
, disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt)
, standardBuilds Amd64 Darwin
- , allowFailureGroup (addValidateRule FreeBSDTag (standardBuilds Amd64 FreeBSD))
+ , allowFailureGroup (addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD13))
, standardBuilds AArch64 Darwin
, standardBuilds AArch64 (Linux Debian10)
, allowFailureGroup (disableValidate (standardBuilds ARMv7 (Linux Debian10)))
=====================================
.gitlab/jobs.yaml
=====================================
@@ -541,7 +541,7 @@
"ac_cv_func_utimensat": "no"
}
},
- "nightly-x86_64-freebsd-validate": {
+ "nightly-x86_64-freebsd13-validate": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh clean",
@@ -551,7 +551,7 @@
"artifacts": {
"expire_in": "8 weeks",
"paths": [
- "ghc-x86_64-freebsd-validate.tar.xz",
+ "ghc-x86_64-freebsd13-validate.tar.xz",
"junit.xml"
],
"reports": {
@@ -560,7 +560,7 @@
"when": "always"
},
"cache": {
- "key": "x86_64-freebsd-$CACHE_REV",
+ "key": "x86_64-freebsd13-$CACHE_REV",
"paths": [
"cabal-cache",
"toolchain"
@@ -588,17 +588,17 @@
],
"stage": "full-build",
"tags": [
- "x86_64-freebsd"
+ "x86_64-freebsd13"
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate",
+ "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate",
"BUILD_FLAVOUR": "validate",
- "CABAL_INSTALL_VERSION": "3.2.0.0",
+ "CABAL_INSTALL_VERSION": "3.6.2.0",
"CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ",
"GHC_VERSION": "9.2.2",
"HADRIAN_ARGS": "--docs=no-sphinx",
- "TEST_ENV": "x86_64-freebsd-validate",
+ "TEST_ENV": "x86_64-freebsd13-validate",
"XZ_OPT": "-9"
}
},
@@ -2050,7 +2050,7 @@
"ac_cv_func_utimensat": "no"
}
},
- "release-x86_64-freebsd-release": {
+ "release-x86_64-freebsd13-release": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh clean",
@@ -2060,7 +2060,7 @@
"artifacts": {
"expire_in": "1 year",
"paths": [
- "ghc-x86_64-freebsd-release.tar.xz",
+ "ghc-x86_64-freebsd13-release.tar.xz",
"junit.xml"
],
"reports": {
@@ -2069,7 +2069,7 @@
"when": "always"
},
"cache": {
- "key": "x86_64-freebsd-$CACHE_REV",
+ "key": "x86_64-freebsd13-$CACHE_REV",
"paths": [
"cabal-cache",
"toolchain"
@@ -2097,18 +2097,18 @@
],
"stage": "full-build",
"tags": [
- "x86_64-freebsd"
+ "x86_64-freebsd13"
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-freebsd-release",
+ "BIN_DIST_NAME": "ghc-x86_64-freebsd13-release",
"BUILD_FLAVOUR": "release",
- "CABAL_INSTALL_VERSION": "3.2.0.0",
+ "CABAL_INSTALL_VERSION": "3.6.2.0",
"CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ",
"GHC_VERSION": "9.2.2",
"HADRIAN_ARGS": "--docs=no-sphinx",
"IGNORE_PERF_FAILURES": "all",
- "TEST_ENV": "x86_64-freebsd-release",
+ "TEST_ENV": "x86_64-freebsd13-release",
"XZ_OPT": "-9"
}
},
@@ -2970,7 +2970,7 @@
"ac_cv_func_utimensat": "no"
}
},
- "x86_64-freebsd-validate": {
+ "x86_64-freebsd13-validate": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh clean",
@@ -2980,7 +2980,7 @@
"artifacts": {
"expire_in": "2 weeks",
"paths": [
- "ghc-x86_64-freebsd-validate.tar.xz",
+ "ghc-x86_64-freebsd13-validate.tar.xz",
"junit.xml"
],
"reports": {
@@ -2989,7 +2989,7 @@
"when": "always"
},
"cache": {
- "key": "x86_64-freebsd-$CACHE_REV",
+ "key": "x86_64-freebsd13-$CACHE_REV",
"paths": [
"cabal-cache",
"toolchain"
@@ -3017,17 +3017,17 @@
],
"stage": "full-build",
"tags": [
- "x86_64-freebsd"
+ "x86_64-freebsd13"
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate",
+ "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate",
"BUILD_FLAVOUR": "validate",
- "CABAL_INSTALL_VERSION": "3.2.0.0",
+ "CABAL_INSTALL_VERSION": "3.6.2.0",
"CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ",
"GHC_VERSION": "9.2.2",
"HADRIAN_ARGS": "--docs=no-sphinx",
- "TEST_ENV": "x86_64-freebsd-validate"
+ "TEST_ENV": "x86_64-freebsd13-validate"
}
},
"x86_64-linux-alpine3_12-int_native-validate+fully_static": {
=====================================
compiler/CodeGen.Platform.h
=====================================
@@ -926,6 +926,14 @@ freeReg 29 = False
-- ip0 -- used for spill offset computations
freeReg 16 = False
+#if defined(darwin_HOST_OS) || defined(ios_HOST_OS)
+-- x18 is reserved by the platform on Darwin/iOS, and can not be used
+-- More about ARM64 ABI that Apple platforms support:
+-- https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms
+-- https://github.com/Siguza/ios-resources/blob/master/bits/arm64.md
+freeReg 18 = False
+#endif
+
# if defined(REG_Base)
freeReg REG_Base = False
# endif
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -299,7 +299,7 @@ linkNodes summaries uid hue =
in if | ghcLink dflags == LinkBinary && isJust ofile && not do_linking ->
Just (Left $ singleMessage $ mkPlainErrorMsgEnvelope noSrcSpan (DriverRedirectedNoMain $ mainModuleNameIs dflags))
-- This should be an error, not a warning (#10895).
- | do_linking -> Just (Right (LinkNode unit_nodes uid))
+ | ghcLink dflags /= NoLink, do_linking -> Just (Right (LinkNode unit_nodes uid))
| otherwise -> Nothing
-- Note [Missing home modules]
=====================================
docs/users_guide/9.4.1-notes.rst
=====================================
@@ -104,7 +104,7 @@ Language
- GHC Proposal `#302 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0302-cases.rst>`_ has been implemented.
This means under ``-XLambdaCase``, a new expression heralded by ``\cases`` is
available, which works like ``\case`` but can match on multiple patterns.
- This means constructor patterns with arguments have to parenthesized here,
+ This means constructor patterns with arguments have to be parenthesized here,
just like in lambda expressions.
- The parsing of implicit parameters is slightly more permissive, as GHC now allows ::
=====================================
ghc.mk
=====================================
@@ -509,11 +509,13 @@ libraries/containers/containers/dist-install/build/Data/IntMap/Internal.o: libra
libraries/containers/containers/dist-install/build/Data/Graph.o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.hi
libraries/containers/containers/dist-install/build/Data/Set/Internal.o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.hi
libraries/containers/containers/dist-install/build/Data/IntSet/Internal.o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.hi
+libraries/containers/containers/dist-install/build/Data/Sequence/Internal.o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.hi
libraries/containers/containers/dist-install/build/Data/IntMap/Internal.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi
libraries/containers/containers/dist-install/build/Data/Graph.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi
libraries/containers/containers/dist-install/build/Data/Set/Internal.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi
libraries/containers/containers/dist-install/build/Data/IntSet/Internal.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi
+libraries/containers/containers/dist-install/build/Data/Sequence/Internal.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi
ifeq "$(BIGNUM_BACKEND)" "gmp"
GMP_ENABLED = YES
=====================================
hadrian/bindist/Makefile
=====================================
@@ -22,43 +22,6 @@ ifeq "$(Darwin_Host)" "YES"
XATTR ?= /usr/bin/xattr
endif
-# installscript
-#
-# $1 = package name
-# $2 = wrapper path
-# $3 = bindir
-# $4 = ghcbindir
-# $5 = Executable binary path
-# $6 = Library Directory
-# $7 = Docs Directory
-# $8 = Includes Directory
-# We are installing wrappers to programs by searching corresponding
-# wrappers. If wrapper is not found, we are attaching the common wrapper
-# to it. This implementation is a bit hacky and depends on consistency
-# of program names. For hadrian build this will work as programs have a
-# consistent naming procedure.
-define installscript
- echo "installscript $1 -> $2"
- @if [ -L 'wrappers/$1' ]; then \
- $(CP) -P 'wrappers/$1' '$2' ; \
- else \
- rm -f '$2' && \
- $(CREATE_SCRIPT) '$2' && \
- echo "#!$(SHELL)" >> '$2' && \
- echo "exedir=\"$4\"" >> '$2' && \
- echo "exeprog=\"$1\"" >> '$2' && \
- echo "executablename=\"$5\"" >> '$2' && \
- echo "bindir=\"$3\"" >> '$2' && \
- echo "libdir=\"$6\"" >> '$2' && \
- echo "docdir=\"$7\"" >> '$2' && \
- echo "includedir=\"$8\"" >> '$2' && \
- echo "" >> '$2' && \
- cat 'wrappers/$1' >> '$2' && \
- $(EXECUTABLE_FILE) '$2' ; \
- fi
- @echo "$1 installed to $2"
-endef
-
# patchpackageconf
#
# Hacky function to patch up the 'haddock-interfaces' and 'haddock-html'
@@ -82,6 +45,8 @@ define patchpackageconf \
((echo "$1" | grep rts) && (cat '$2.copy' | sed 's|haddock-.*||' > '$2.copy.copy')) || (cat '$2.copy' > '$2.copy.copy')
# We finally replace the original file.
mv '$2.copy.copy' '$2'
+ # Fix the mode, in case umask is set
+ chmod 644 '$2'
endef
# QUESTION : should we use shell commands?
@@ -216,10 +181,12 @@ install_lib: lib/settings
install_docs:
@echo "Copying docs to $(DESTDIR)$(docdir)"
$(INSTALL_DIR) "$(DESTDIR)$(docdir)"
- cd doc; $(FIND) . -type f -exec sh -c \
- '$(INSTALL_DIR) "$(DESTDIR)$(docdir)/`dirname $$1`" && \
- $(INSTALL_DATA) "$$1" "$(DESTDIR)$(docdir)/`dirname $$1`" \
- ' sh '{}' \;
+
+ if [ -d doc ]; then \
+ cd doc; $(FIND) . -type f -exec sh -c \
+ '$(INSTALL_DIR) "$(DESTDIR)$(docdir)/`dirname $$1`" && $(INSTALL_DATA) "$$1" "$(DESTDIR)$(docdir)/`dirname $$1`"' \
+ sh '{}' ';'; \
+ fi
if [ -d docs-utils ]; then \
$(INSTALL_DIR) "$(DESTDIR)$(docdir)/html/libraries/"; \
@@ -227,12 +194,13 @@ install_docs:
$(INSTALL_SCRIPT) docs-utils/gen_contents_index "$(DESTDIR)$(docdir)/html/libraries/"; \
fi
-BINARY_NAMES=$(shell ls ./wrappers/)
+export SHELL
install_wrappers: install_bin_libdir
@echo "Installing wrapper scripts"
$(INSTALL_DIR) "$(DESTDIR)$(WrapperBinsDir)"
- $(foreach p, $(BINARY_NAMES),\
- $(call installscript,$p,$(DESTDIR)$(WrapperBinsDir)/$p,$(WrapperBinsDir),$(ActualBinsDir),$(ActualBinsDir)/$p,$(ActualLibsDir),$(docdir),$(includedir)))
+ for p in `cd wrappers; $(FIND) . ! -type d`; do \
+ mk/install_script.sh "$$p" "$(DESTDIR)/$(WrapperBinsDir)/$$p" "$(WrapperBinsDir)" "$(ActualBinsDir)" "$(ActualBinsDir)/$$p" "$(ActualLibsDir)" "$(docdir)" "$(includedir)"; \
+ done
PKG_CONFS = $(shell find "$(DESTDIR)$(ActualLibsDir)/package.conf.d" -name '*.conf' | sed "s: :\0xxx\0:g")
update_package_db: install_bin install_lib
=====================================
hadrian/src/Rules/BinaryDist.hs
=====================================
@@ -349,6 +349,7 @@ bindistInstallFiles =
, "mk" -/- "config.mk.in", "mk" -/- "install.mk.in", "mk" -/- "project.mk"
, "mk" -/- "relpath.sh"
, "mk" -/- "system-cxx-std-lib-1.0.conf.in"
+ , "mk" -/- "install_script.sh"
, "README", "INSTALL" ]
-- | This auxiliary function gives us a top-level 'Filepath' that we can 'need'
=====================================
hadrian/src/Settings/Builders/RunTest.hs
=====================================
@@ -278,6 +278,7 @@ runTestBuilderArgs = builder Testsuite ? do
where emitWhenSet Nothing _ = mempty
emitWhenSet (Just v) f = f v
+ stageNumber :: Stage -> Int
stageNumber (Stage0 GlobalLibs) = error "stageNumber stageBoot"
stageNumber (Stage0 InTreeLibs) = 1
stageNumber Stage1 = 2
=====================================
libraries/base/GHC/Event/Thread.hs
=====================================
@@ -18,7 +18,7 @@ module GHC.Event.Thread
-- TODO: Use new Windows I/O manager
import Control.Exception (finally, SomeException, toException)
import Data.Foldable (forM_, mapM_, sequence_)
-import Data.IORef (IORef, newIORef, readIORef, writeIORef)
+import Data.IORef (IORef, newIORef, readIORef, writeIORef, atomicWriteIORef)
import Data.Maybe (fromMaybe)
import Data.Tuple (snd)
import Foreign.C.Error (eBADF, errnoToIOError)
@@ -29,7 +29,8 @@ import GHC.List (zipWith, zipWith3)
import GHC.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO,
labelThread, modifyMVar_, withMVar, newTVar, sharedCAF,
getNumCapabilities, threadCapability, myThreadId, forkOn,
- threadStatus, writeTVar, newTVarIO, readTVar, retry,throwSTM,STM)
+ threadStatus, writeTVar, newTVarIO, readTVar, retry,
+ throwSTM, STM, yield)
import GHC.IO (mask_, uninterruptibleMask_, onException)
import GHC.IO.Exception (ioError)
import GHC.IOArray (IOArray, newIOArray, readIOArray, writeIOArray,
@@ -41,6 +42,7 @@ import GHC.Event.Manager (Event, EventManager, evtRead, evtWrite, loop,
new, registerFd, unregisterFd_)
import qualified GHC.Event.Manager as M
import qualified GHC.Event.TimerManager as TM
+import GHC.Ix (inRange)
import GHC.Num ((-), (+))
import GHC.Real (fromIntegral)
import GHC.Show (showSignedInt)
@@ -98,22 +100,44 @@ threadWaitWrite = threadWait evtWrite
closeFdWith :: (Fd -> IO ()) -- ^ Action that performs the close.
-> Fd -- ^ File descriptor to close.
-> IO ()
-closeFdWith close fd = do
- eventManagerArray <- readIORef eventManager
- let (low, high) = boundsIOArray eventManagerArray
- mgrs <- flip mapM [low..high] $ \i -> do
- Just (_,!mgr) <- readIOArray eventManagerArray i
- return mgr
- -- 'takeMVar', and 'M.closeFd_' might block, although for a very short time.
- -- To make 'closeFdWith' safe in presence of asynchronous exceptions we have
- -- to use uninterruptible mask.
- uninterruptibleMask_ $ do
- tables <- flip mapM mgrs $ \mgr -> takeMVar $ M.callbackTableVar mgr fd
- cbApps <- zipWithM (\mgr table -> M.closeFd_ mgr table fd) mgrs tables
- close fd `finally` sequence_ (zipWith3 finish mgrs tables cbApps)
+closeFdWith close fd = close_loop
where
finish mgr table cbApp = putMVar (M.callbackTableVar mgr fd) table >> cbApp
zipWithM f xs ys = sequence (zipWith f xs ys)
+ -- The array inside 'eventManager' can be swapped out at any time, see
+ -- 'ioManagerCapabilitiesChanged'. See #21651. We detect this case by
+ -- checking the array bounds before and after. When such a swap has
+ -- happened we cleanup and try again
+ close_loop = do
+ eventManagerArray <- readIORef eventManager
+ let ema_bounds@(low, high) = boundsIOArray eventManagerArray
+ mgrs <- flip mapM [low..high] $ \i -> do
+ Just (_,!mgr) <- readIOArray eventManagerArray i
+ return mgr
+
+ -- 'takeMVar', and 'M.closeFd_' might block, although for a very short time.
+ -- To make 'closeFdWith' safe in presence of asynchronous exceptions we have
+ -- to use uninterruptible mask.
+ join $ uninterruptibleMask_ $ do
+ tables <- flip mapM mgrs $ \mgr -> takeMVar $ M.callbackTableVar mgr fd
+ new_ema_bounds <- boundsIOArray `fmap` readIORef eventManager
+ -- Here we exploit Note [The eventManager Array]
+ if new_ema_bounds /= ema_bounds
+ then do
+ -- the array has been modified.
+ -- mgrs still holds the right EventManagers, by the Note.
+ -- new_ema_bounds must be larger than ema_bounds, by the note.
+ -- return the MVars we took and try again
+ sequence_ $ zipWith (\mgr table -> finish mgr table (pure ())) mgrs tables
+ pure close_loop
+ else do
+ -- We surely have taken all the appropriate MVars. Even if the array
+ -- has been swapped, our mgrs is still correct.
+ -- Remove the Fd from all callback tables, close the Fd, and run all
+ -- callbacks.
+ cbApps <- zipWithM (\mgr table -> M.closeFd_ mgr table fd) mgrs tables
+ close fd `finally` sequence_ (zipWith3 finish mgrs tables cbApps)
+ pure (pure ())
threadWait :: Event -> Fd -> IO ()
threadWait evt fd = mask_ $ do
@@ -177,10 +201,24 @@ threadWaitWriteSTM = threadWaitSTM evtWrite
getSystemEventManager :: IO (Maybe EventManager)
getSystemEventManager = do
t <- myThreadId
- (cap, _) <- threadCapability t
eventManagerArray <- readIORef eventManager
- mmgr <- readIOArray eventManagerArray cap
- return $ fmap snd mmgr
+ let r = boundsIOArray eventManagerArray
+ (cap, _) <- threadCapability t
+ -- It is possible that we've just increased the number of capabilities and the
+ -- new EventManager has not yet been constructed by
+ -- 'ioManagerCapabilitiesChanged'. We expect this to happen very rarely.
+ -- T21561 exercises this.
+ -- Two options to proceed:
+ -- 1) return the EventManager for capability 0. This is guaranteed to exist,
+ -- and "shouldn't" cause any correctness issues.
+ -- 2) Busy wait, with or without a call to 'yield'. This can't deadlock,
+ -- because we must be on a brand capability and there must be a call to
+ -- 'ioManagerCapabilitiesChanged' pending.
+ --
+ -- We take the second option, with the yield, judging it the most robust.
+ if not (inRange r cap)
+ then yield >> getSystemEventManager
+ else fmap snd `fmap` readIOArray eventManagerArray cap
getSystemEventManager_ :: IO EventManager
getSystemEventManager_ = do
@@ -191,6 +229,22 @@ getSystemEventManager_ = do
foreign import ccall unsafe "getOrSetSystemEventThreadEventManagerStore"
getOrSetSystemEventThreadEventManagerStore :: Ptr a -> IO (Ptr a)
+-- Note [The eventManager Array]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- A mutable array holding the current EventManager for each capability
+-- An entry is Nothing only while the eventmanagers are initialised, see
+-- 'startIOManagerThread' and 'ioManagerCapabilitiesChanged'.
+-- The 'ThreadId' at array position 'cap' will have been 'forkOn'ed capabality
+-- 'cap'.
+-- The array will be swapped with newer arrays when the number of capabilities
+-- changes(via 'setNumCapabilities'). However:
+-- * the size of the arrays will never decrease; and
+-- * The 'EventManager's in the array are not replaced with other
+-- 'EventManager' constructors.
+--
+-- This is a similar strategy as the rts uses for it's
+-- capabilities array (n_capabilities is the size of the array,
+-- enabled_capabilities' is the number of active capabilities).
eventManager :: IORef (IOArray Int (Maybe (ThreadId, EventManager)))
eventManager = unsafePerformIO $ do
numCaps <- getNumCapabilities
@@ -351,7 +405,9 @@ ioManagerCapabilitiesChanged =
startIOManagerThread new_eventManagerArray
-- update the event manager array reference:
- writeIORef eventManager new_eventManagerArray
+ atomicWriteIORef eventManager new_eventManagerArray
+ -- We need an atomic write here because 'eventManager' is accessed
+ -- unsynchronized in 'getSystemEventManager' and 'closeFdWith'
else when (new_n_caps > numEnabled) $
forM_ [numEnabled..new_n_caps-1] $ \i -> do
Just (_,mgr) <- readIOArray eventManagerArray i
=====================================
libraries/base/changelog.md
=====================================
@@ -77,6 +77,21 @@
`Word64#` and `Int64#`, respectively. Previously on 32-bit platforms these
were rather represented by `Word#` and `Int#`. See GHC #11953.
+## 4.16.3.0 *May 2022*
+
+ * Shipped with GHC 9.2.4
+
+ * winio: make consoleReadNonBlocking not wait for any events at all.
+
+ * winio: Add support to console handles to handleToHANDLE
+
+## 4.16.2.0 *May 2022*
+
+ * Shipped with GHC 9.2.2
+
+ * Export GHC.Event.Internal on Windows (#21245)
+
+ # Documentation Fixes
## 4.16.1.0 *Feb 2022*
=====================================
m4/fp_find_cxx_std_lib.m4
=====================================
@@ -18,10 +18,44 @@ unknown
#endif
EOF
AC_MSG_CHECKING([C++ standard library flavour])
- if "$CXX" -E actest.cpp -o actest.out; then
- if grep "libc++" actest.out >/dev/null; then
- CXX_STD_LIB_LIBS="c++ c++abi"
- p="`"$CXX" --print-file-name libc++.so`"
+ if ! "$CXX" -E actest.cpp -o actest.out; then
+ rm -f actest.cpp actest.out
+ AC_MSG_ERROR([Failed to compile test program])
+ fi
+
+ dnl Identify standard library type
+ if grep "libc++" actest.out >/dev/null; then
+ CXX_STD_LIB_FLAVOUR="c++"
+ AC_MSG_RESULT([libc++])
+ elif grep "libstdc++" actest.out >/dev/null; then
+ CXX_STD_LIB_FLAVOUR="stdc++"
+ AC_MSG_RESULT([libstdc++])
+ else
+ rm -f actest.cpp actest.out
+ AC_MSG_ERROR([Unknown C++ standard library implementation.])
+ fi
+ rm -f actest.cpp actest.out
+
+ dnl -----------------------------------------
+ dnl Figure out how to link...
+ dnl -----------------------------------------
+ cat >actest.cpp <<-EOF
+#include <iostream>
+int main(int argc, char** argv) {
+ std::cout << "hello world\n";
+ return 0;
+}
+EOF
+ if ! "$CXX" -c actest.cpp; then
+ AC_MSG_ERROR([Failed to compile test object])
+ fi
+
+ try_libs() {
+ dnl Try to link a plain object with CC manually
+ AC_MSG_CHECKING([for linkage against '${3}'])
+ if "$CC" -o actest actest.o ${1} 2>/dev/null; then
+ CXX_STD_LIB_LIBS="${3}"
+ p="`"$CXX" --print-file-name ${2}`"
d="`dirname "$p"`"
dnl On some platforms (e.g. Windows) the C++ standard library
dnl can be found in the system search path. In this case $CXX
@@ -31,24 +65,25 @@ EOF
if test "$d" = "."; then d=""; fi
CXX_STD_LIB_LIB_DIRS="$d"
CXX_STD_LIB_DYN_LIB_DIRS="$d"
- AC_MSG_RESULT([libc++])
- elif grep "libstdc++" actest.out >/dev/null; then
- CXX_STD_LIB_LIBS="stdc++"
- p="`"$CXX" --print-file-name libstdc++.so`"
- d="`dirname "$p"`"
- if test "$d" = "."; then d=""; fi
- CXX_STD_LIB_LIB_DIRS="$d"
- CXX_STD_LIB_DYN_LIB_DIRS="$d"
- AC_MSG_RESULT([libstdc++])
+ AC_MSG_RESULT([success])
+ true
else
- rm -f actest.cpp actest.out
- AC_MSG_ERROR([Unknown C++ standard library implementation.])
+ AC_MSG_RESULT([failed])
+ false
fi
- rm -f actest.cpp actest.out
- else
- rm -f actest.cpp actest.out
- AC_MSG_ERROR([Failed to compile test program])
- fi
+ }
+ case $CXX_STD_LIB_FLAVOUR in
+ c++)
+ try_libs "-lc++ -lc++abi" "libc++.so" "c++ c++abi" || \
+ try_libs "-lc++ -lcxxrt" "libc++.so" "c++ cxxrt" ||
+ AC_MSG_ERROR([Failed to find C++ standard library]) ;;
+ stdc++)
+ try_libs "-lstdc++" "libstdc++.so" "stdc++" || \
+ try_libs "-lstdc++ -lsupc++" "libstdc++.so" "stdc++ supc++" || \
+ AC_MSG_ERROR([Failed to find C++ standard library]) ;;
+ esac
+
+ rm -f actest.cpp actest.o actest
fi
AC_SUBST([CXX_STD_LIB_LIBS])
=====================================
mk/install_script.sh
=====================================
@@ -0,0 +1,34 @@
+#!/bin/sh
+
+# $1 = executable name
+# $2 = wrapper path
+# $3 = bindir
+# $4 = ghcbindir
+# $5 = Executable binary path
+# $6 = Library Directory
+# $7 = Docs Directory
+# $8 = Includes Directory
+# We are installing wrappers to programs by searching corresponding
+# wrappers. If wrapper is not found, we are attaching the common wrapper
+# to it. This implementation is a bit hacky and depends on consistency
+# of program names. For hadrian build this will work as programs have a
+# consistent naming procedure.
+
+echo "Installing $1 -> $2"
+if [ -L "wrappers/$1" ]; then
+ cp -RP "wrappers/$1" "$2"
+else
+ rm -f "$2" &&
+ touch "$2" &&
+ echo "#!$SHELL" >> "$2" &&
+ echo "exedir=\"$4\"" >> "$2" &&
+ echo "exeprog=\"$1\"" >> "$2" &&
+ echo "executablename=\"$5\"" >> "$2" &&
+ echo "bindir=\"$3\"" >> "$2" &&
+ echo "libdir=\"$6\"" >> "$2" &&
+ echo "docdir=\"$7\"" >> "$2" &&
+ echo "includedir=\"$8\"" >> "$2" &&
+ echo "" >> "$2" &&
+ cat "wrappers/$1" >> "$2" &&
+ chmod 755 "$2"
+fi
=====================================
rts/Linker.c
=====================================
@@ -80,6 +80,33 @@
#if defined(dragonfly_HOST_OS)
#include <sys/tls.h>
#endif
+
+/*
+ * Note [iconv and FreeBSD]
+ * ~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ * On FreeBSD libc.so provides an implementation of the iconv_* family of
+ * functions. However, due to their implementation, these symbols cannot be
+ * resolved via dlsym(); rather, they can only be resolved using the
+ * explicitly-versioned dlvsym().
+ *
+ * This is problematic for the RTS linker since we may be asked to load
+ * an object that depends upon iconv. To handle this we include a set of
+ * fallback cases for these functions, allowing us to resolve them to the
+ * symbols provided by the libc against which the RTS is linked.
+ *
+ * See #20354.
+ */
+
+#if defined(freebsd_HOST_OS)
+extern void iconvctl();
+extern void iconv_open_into();
+extern void iconv_open();
+extern void iconv_close();
+extern void iconv_canonicalize();
+extern void iconv();
+#endif
+
/*
Note [runtime-linker-support]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -637,6 +664,10 @@ internal_dlsym(const char *symbol) {
}
RELEASE_LOCK(&dl_mutex);
+ IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol));
+# define SPECIAL_SYMBOL(sym) \
+ if (strcmp(symbol, #sym) == 0) return (void*)&sym;
+
# if defined(HAVE_SYS_STAT_H) && defined(linux_HOST_OS) && defined(__GLIBC__)
// HACK: GLIBC implements these functions with a great deal of trickery where
// they are either inlined at compile time to their corresponding
@@ -646,18 +677,28 @@ internal_dlsym(const char *symbol) {
// We borrow the approach that the LLVM JIT uses to resolve these
// symbols. See http://llvm.org/PR274 and #7072 for more info.
- IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in GLIBC special cases\n", symbol));
+ SPECIAL_SYMBOL(stat);
+ SPECIAL_SYMBOL(fstat);
+ SPECIAL_SYMBOL(lstat);
+ SPECIAL_SYMBOL(stat64);
+ SPECIAL_SYMBOL(fstat64);
+ SPECIAL_SYMBOL(lstat64);
+ SPECIAL_SYMBOL(atexit);
+ SPECIAL_SYMBOL(mknod);
+# endif
- if (strcmp(symbol, "stat") == 0) return (void*)&stat;
- if (strcmp(symbol, "fstat") == 0) return (void*)&fstat;
- if (strcmp(symbol, "lstat") == 0) return (void*)&lstat;
- if (strcmp(symbol, "stat64") == 0) return (void*)&stat64;
- if (strcmp(symbol, "fstat64") == 0) return (void*)&fstat64;
- if (strcmp(symbol, "lstat64") == 0) return (void*)&lstat64;
- if (strcmp(symbol, "atexit") == 0) return (void*)&atexit;
- if (strcmp(symbol, "mknod") == 0) return (void*)&mknod;
+ // See Note [iconv and FreeBSD]
+# if defined(freebsd_HOST_OS)
+ SPECIAL_SYMBOL(iconvctl);
+ SPECIAL_SYMBOL(iconv_open_into);
+ SPECIAL_SYMBOL(iconv_open);
+ SPECIAL_SYMBOL(iconv_close);
+ SPECIAL_SYMBOL(iconv_canonicalize);
+ SPECIAL_SYMBOL(iconv);
# endif
+#undef SPECIAL_SYMBOL
+
// we failed to find the symbol
return NULL;
}
=====================================
testsuite/tests/concurrent/should_run/T21651.hs
=====================================
@@ -0,0 +1,124 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+
+-- This test is adapted from setnumcapabilities001.
+
+import GHC.Conc hiding (threadWaitRead, threadWaitWrite)
+import GHC.Exts
+import GHC.IO.Encoding
+import System.Environment
+import System.IO
+import Control.Monad
+import Text.Printf
+import Data.Time.Clock
+import Control.DeepSeq
+
+import System.Posix.IO
+import System.Posix.Types
+import Control.Concurrent
+import Control.Exception
+
+passTheParcel :: Int -> IO (IO ())
+passTheParcel n = do
+ pipes@(p1 : rest) <- forM [0..n-1] $ \_ -> createPipe
+ rs@((_,tid1) : _) <- forM (pipes `zip` (rest ++ [p1])) $ \((readfd, _), (_, writefd)) -> do
+ let
+ read = fdRead readfd $ fromIntegral 1
+ write = fdWrite writefd
+ mv <- newEmptyMVar
+ tid <- forkIO $ let
+ loop = flip catch (\(x :: IOException) -> pure ()) $ forever $ do
+ threadWaitRead readfd
+ (s, _) <- read
+ threadWaitWrite writefd
+ write s
+ cleanup = do
+ closeFdWith closeFd readfd
+ closeFdWith closeFd writefd
+ putMVar mv ()
+ in loop `finally` cleanup
+ pure (mv, tid)
+
+ let
+ cleanup = do
+ killThread tid1
+ forM_ rs $ \(mv, _) -> takeMVar mv
+
+ fdWrite (snd p1) "a"
+ pure cleanup
+
+
+main = do
+ setLocaleEncoding latin1 -- fdRead and fdWrite depend on the current locale
+ [n,q,t,z] <- fmap (fmap read) getArgs
+ cleanup_ptp <- passTheParcel z
+ t <- forkIO $ do
+ forM_ (cycle ([n,n-1..1] ++ [2..n-1])) $ \m -> do
+ setNumCapabilities m
+ threadDelay t
+ printf "%d\n" (nqueens q)
+ cleanup_ptp
+ killThread t
+ -- If we don't kill the child thread, it might be about to
+ -- call setNumCapabilities() in C when the main thread exits,
+ -- and chaos can ensue. See #12038
+
+nqueens :: Int -> Int
+nqueens nq = length (pargen 0 [])
+ where
+ safe :: Int -> Int -> [Int] -> Bool
+ safe x d [] = True
+ safe x d (q:l) = x /= q && x /= q+d && x /= q-d && safe x (d+1) l
+
+ gen :: [[Int]] -> [[Int]]
+ gen bs = [ (q:b) | b <- bs, q <- [1..nq], safe q 1 b ]
+
+ pargen :: Int -> [Int] -> [[Int]]
+ pargen n b
+ | n >= threshold = iterate gen [b] !! (nq - n)
+ | otherwise = concat bs
+ where bs = map (pargen (n+1)) (gen [b]) `using` parList rdeepseq
+
+ threshold = 3
+
+using :: a -> Strategy a -> a
+x `using` strat = runEval (strat x)
+
+type Strategy a = a -> Eval a
+
+newtype Eval a = Eval (State# RealWorld -> (# State# RealWorld, a #))
+
+runEval :: Eval a -> a
+runEval (Eval x) = case x realWorld# of (# _, a #) -> a
+
+instance Functor Eval where
+ fmap = liftM
+
+instance Applicative Eval where
+ pure x = Eval $ \s -> (# s, x #)
+ (<*>) = ap
+
+instance Monad Eval where
+ return = pure
+ Eval x >>= k = Eval $ \s -> case x s of
+ (# s', a #) -> case k a of
+ Eval f -> f s'
+
+parList :: Strategy a -> Strategy [a]
+parList strat = traverse (rparWith strat)
+
+rpar :: Strategy a
+rpar x = Eval $ \s -> spark# x s
+
+rseq :: Strategy a
+rseq x = Eval $ \s -> seq# x s
+
+rparWith :: Strategy a -> Strategy a
+rparWith s a = do l <- rpar r; return (case l of Lift x -> x)
+ where r = case s a of
+ Eval f -> case f realWorld# of
+ (# _, a' #) -> Lift a'
+
+data Lift a = Lift a
+
+rdeepseq :: NFData a => Strategy a
+rdeepseq x = do rseq (rnf x); return x
=====================================
testsuite/tests/concurrent/should_run/T21651.stdout
=====================================
@@ -0,0 +1 @@
+14200
=====================================
testsuite/tests/concurrent/should_run/all.T
=====================================
@@ -218,12 +218,20 @@ test('conc067', ignore_stdout, compile_and_run, [''])
test('conc068', [ omit_ways(concurrent_ways), exit_code(1) ], compile_and_run, [''])
test('setnumcapabilities001',
- [ only_ways(['threaded1','threaded2', 'nonmoving_thr']),
+ [ only_ways(['threaded1','threaded2', 'nonmoving_thr', 'profthreaded']),
extra_run_opts('8 12 2000'),
when(have_thread_sanitizer(), expect_broken(18808)),
req_smp ],
compile_and_run, [''])
+test('T21651',
+ [ only_ways(['threaded1','threaded2', 'nonmoving_thr', 'profthreaded']),
+ when(opsys('mingw32'),skip), # uses POSIX pipes
+ when(opsys('darwin'),extra_run_opts('8 12 2000 100')),
+ unless(opsys('darwin'),extra_run_opts('8 12 2000 200')), # darwin runners complain of too many open files
+ req_smp ],
+ compile_and_run, [''])
+
test('hs_try_putmvar001',
[
when(opsys('mingw32'),skip), # uses pthread APIs in the C code
=====================================
testsuite/tests/driver/T20316.stdout
=====================================
@@ -1,4 +1,4 @@
-[1 of 2] Compiling Main ( T20316.hs, nothing )
+[1 of 1] Compiling Main ( T20316.hs, nothing )
*** non-module.dump-timings ***
initializing unit database:
Chasing dependencies:
=====================================
testsuite/tests/driver/T21866.hs
=====================================
@@ -0,0 +1,3 @@
+module Main where
+
+main = print ()
=====================================
testsuite/tests/driver/T21866.stderr
=====================================
@@ -0,0 +1 @@
+[1 of 1] Compiling Main ( T21866.hs, T21866.o )
=====================================
testsuite/tests/driver/all.T
=====================================
@@ -306,4 +306,5 @@ test('T20316', normal, makefile_test, [])
test('MultiRootsErr', normal, multimod_compile_fail, ['MultiRootsErr', 'MultiRootsErr'])
test('patch-level2', normal, compile, ['-Wcpp-undef'])
test('T20569', extra_files(["T20569/"]), makefile_test, [])
+test('T21866', normal, multimod_compile, ['T21866','-no-link'])
test('T21869', normal, makefile_test, [])
=====================================
testsuite/tests/driver/recomp007/recomp007.stdout
=====================================
@@ -1,6 +1,6 @@
"1.0"
Preprocessing executable 'test' for b-1.0..
Building executable 'test' for b-1.0..
-[1 of 3] Compiling B ( B.hs, dist/build/test/test-tmp/B.o ) [A package changed]
+[1 of 2] Compiling B ( B.hs, dist/build/test/test-tmp/B.o ) [A package changed]
[3 of 3] Linking dist/build/test/test [Objects changed]
"2.0"
=====================================
testsuite/tests/driver/retc001/retc001.stdout
=====================================
@@ -1,7 +1,7 @@
-[1 of 4] Compiling A ( A.hs, nothing )
-[2 of 4] Compiling B ( B.hs, nothing )
-[3 of 4] Compiling Main ( C.hs, nothing )
+[1 of 3] Compiling A ( A.hs, nothing )
+[2 of 3] Compiling B ( B.hs, nothing )
+[3 of 3] Compiling Main ( C.hs, nothing )
Middle
End
-[2 of 4] Compiling B ( B.hs, nothing ) [Source file changed]
-[3 of 4] Compiling Main ( C.hs, nothing ) [B changed]
+[2 of 3] Compiling B ( B.hs, nothing ) [Source file changed]
+[3 of 3] Compiling Main ( C.hs, nothing ) [B changed]
=====================================
testsuite/tests/indexed-types/should_compile/impexp.stderr
=====================================
@@ -1,2 +1,2 @@
-[1 of 3] Compiling Exp ( Exp.hs, Exp.o )
-[2 of 3] Compiling Imp ( Imp.hs, Imp.o )
+[1 of 2] Compiling Exp ( Exp.hs, Exp.o )
+[2 of 2] Compiling Imp ( Imp.hs, Imp.o )
=====================================
testsuite/tests/typecheck/should_fail/T6018fail.stderr
=====================================
@@ -1,8 +1,8 @@
-[1 of 6] Compiling T6018Afail ( T6018Afail.hs, T6018Afail.o )
-[2 of 6] Compiling T6018Bfail ( T6018Bfail.hs, T6018Bfail.o )
-[3 of 6] Compiling T6018Cfail ( T6018Cfail.hs, T6018Cfail.o )
-[4 of 6] Compiling T6018Dfail ( T6018Dfail.hs, T6018Dfail.o )
-[5 of 6] Compiling T6018fail ( T6018fail.hs, T6018fail.o )
+[1 of 5] Compiling T6018Afail ( T6018Afail.hs, T6018Afail.o )
+[2 of 5] Compiling T6018Bfail ( T6018Bfail.hs, T6018Bfail.o )
+[3 of 5] Compiling T6018Cfail ( T6018Cfail.hs, T6018Cfail.o )
+[4 of 5] Compiling T6018Dfail ( T6018Dfail.hs, T6018Dfail.o )
+[5 of 5] Compiling T6018fail ( T6018fail.hs, T6018fail.o )
T6018fail.hs:15:15: error:
Type family equation right-hand sides overlap; this violates
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/29319dafda95f95f2b2b9f2444b319d8026ab187...0bea62ff81bd05ed4c88b6c96a1d77f857936114
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/29319dafda95f95f2b2b9f2444b319d8026ab187...0bea62ff81bd05ed4c88b6c96a1d77f857936114
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20220815/77c3bd45/attachment-0001.html>
More information about the ghc-commits
mailing list