[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 10 commits: Revert "Pass preprocessor options to C compiler when building foreign C files (#16737)"
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri Oct 6 03:46:39 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
8ff3134e by Matthew Pickering at 2023-10-05T05:34:58-04:00
Revert "Pass preprocessor options to C compiler when building foreign C files (#16737)"
This reverts commit 1c18d3b41f897f34a93669edaebe6069f319f9e2.
`-optP` should pass options to the preprocessor, that might be a very
different program to the C compiler, so passing the options to the C
compiler is likely to result in `-optP` being useless.
Fixes #17185 and #21291
- - - - -
8f6010b9 by Ben Gamari at 2023-10-05T05:35:36-04:00
rts/nonmoving: Fix on LLP64 platforms
Previously `NONMOVING_SEGMENT_MASK` and friends were defined with the `UL`
size suffix. However, this is wrong on LLP64 platforms like Windows,
where `long` is 32-bits.
Fixes #23003.
Fixes #24042.
- - - - -
f20d02f8 by Andreas Klebinger at 2023-10-05T05:36:14-04:00
Fix isAArch64Bitmask for 32bit immediates.
Fixes #23802
- - - - -
63afb701 by Bryan Richter at 2023-10-05T05:36:49-04:00
Work around perf note fetch failure
Addresses #24055.
- - - - -
242102f4 by Krzysztof Gogolewski at 2023-10-05T05:37:26-04:00
Add a test for #21348
- - - - -
7d390bce by Rewbert at 2023-10-05T05:38:08-04:00
Fixes #24046
- - - - -
2b2352db by Ben Gamari at 2023-10-05T10:22:10+00:00
testsuite: Fix invalid string literal
`"\+"` is not a valid Python string; this should have been `r"\+"`.
- - - - -
2c8c8ce8 by Ben Gamari at 2023-10-05T10:22:10+00:00
rts/nonmoving: Reflow notes
- - - - -
7ef28e05 by Ben Gamari at 2023-10-05T10:22:10+00:00
testsuite: Run some tests unconditionally in nonmoving ways
Improve test coverage of the nonmoving collector by running a small
subset of tests unconditionally with the nonmoving collector.
Fixes #24052.
- - - - -
742d819d by David Binder at 2023-10-05T23:45:51-04:00
Update hpc-bin submodule to 0.69
- - - - -
21 changed files:
- .gitlab/test-metrics.sh
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- driver/ghci/ghci-wrapper.cabal.in
- hadrian/src/Rules/BinaryDist.hs
- hadrian/src/Settings/Packages.hs
- rts/sm/NonMoving.c
- rts/sm/NonMoving.h
- testsuite/driver/testlib.py
- testsuite/tests/array/should_run/all.T
- testsuite/tests/concurrent/should_run/all.T
- − testsuite/tests/driver/T16737.hs
- − testsuite/tests/driver/T16737.stdout
- − testsuite/tests/driver/T16737include/T16737.h
- testsuite/tests/driver/all.T
- testsuite/tests/hpc/T17073.stdout
- + testsuite/tests/simplCore/should_compile/T21348.hs
- testsuite/tests/simplCore/should_compile/all.T
- + testsuite/tests/th/T24046.hs
- testsuite/tests/th/all.T
- utils/hpc
Changes:
=====================================
.gitlab/test-metrics.sh
=====================================
@@ -17,7 +17,12 @@ fail() {
function pull() {
local ref="refs/notes/$REF"
- run git fetch -f "$NOTES_ORIGIN" "$ref:$ref"
+ # 2023-10-04: `git fetch` started failing, first on Darwin in CI and then on
+ # Linux locally, both using git version 2.40.1. See #24055. One workaround is
+ # to set a larger http.postBuffer, although this is definitely a workaround.
+ # The default should work just fine. The error could be in git, GitLab, or
+ # perhaps the networking tube (including all proxies etc) between the two.
+ run git -c http.postBuffer=2097152 fetch -f "$NOTES_ORIGIN" "$ref:$ref"
echo "perf notes ref $ref is $(git rev-parse $ref)"
}
=====================================
compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
=====================================
@@ -781,12 +781,12 @@ getRegister' config plat expr
return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
-- 3. Logic &&, ||
- CmmMachOp (MO_And w) [(CmmReg reg), CmmLit (CmmInt n _)] | isAArch64Bitmask (fromIntegral n) ->
+ CmmMachOp (MO_And w) [(CmmReg reg), CmmLit (CmmInt n _)] | isAArch64Bitmask (opRegWidth w') (fromIntegral n) ->
return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (AND (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n))))
where w' = formatToWidth (cmmTypeFormat (cmmRegType reg))
r' = getRegisterReg plat reg
- CmmMachOp (MO_Or w) [(CmmReg reg), CmmLit (CmmInt n _)] | isAArch64Bitmask (fromIntegral n) ->
+ CmmMachOp (MO_Or w) [(CmmReg reg), CmmLit (CmmInt n _)] | isAArch64Bitmask (opRegWidth w') (fromIntegral n) ->
return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (ORR (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n))))
where w' = formatToWidth (cmmTypeFormat (cmmRegType reg))
r' = getRegisterReg plat reg
@@ -1070,13 +1070,16 @@ getRegister' config plat expr
-- | Is a given number encodable as a bitmask immediate?
--
-- https://stackoverflow.com/questions/30904718/range-of-immediate-values-in-armv8-a64-assembly
-isAArch64Bitmask :: Integer -> Bool
+isAArch64Bitmask :: Width -> Integer -> Bool
-- N.B. zero and ~0 are not encodable as bitmask immediates
-isAArch64Bitmask 0 = False
-isAArch64Bitmask n
- | n == bit 64 - 1 = False
-isAArch64Bitmask n =
- check 64 || check 32 || check 16 || check 8
+isAArch64Bitmask width n =
+ assert (width `elem` [W32,W64]) $
+ case n of
+ 0 -> False
+ _ | n == bit (widthInBits width) - 1
+ -> False -- 1111...1111
+ | otherwise
+ -> (width == W64 && check 64) || check 32 || check 16 || check 8
where
-- Check whether @n@ can be represented as a subpattern of the given
-- width.
=====================================
compiler/GHC/Driver/Pipeline/Execute.hs
=====================================
@@ -411,19 +411,6 @@ runCcPhase cc_phase pipe_env hsc_env location input_fn = do
includePathsQuoteImplicit cmdline_include_paths)
let include_paths = include_paths_quote ++ include_paths_global
- -- pass -D or -optP to preprocessor when compiling foreign C files
- -- (#16737). Doing it in this way is simpler and also enable the C
- -- compiler to perform preprocessing and parsing in a single pass,
- -- but it may introduce inconsistency if a different pgm_P is specified.
- let opts = getOpts dflags opt_P
- aug_imports = augmentImports dflags opts
-
- more_preprocessor_opts = concat
- [ ["-Xpreprocessor", i]
- | not hcc
- , i <- aug_imports
- ]
-
let gcc_extra_viac_flags = extraGccViaCFlags dflags
let pic_c_flags = picCCOpts dflags
@@ -512,7 +499,6 @@ runCcPhase cc_phase pipe_env hsc_env location input_fn = do
++ [ "-include", ghcVersionH ]
++ framework_paths
++ include_paths
- ++ more_preprocessor_opts
++ pkg_extra_cc_opts
))
=====================================
driver/ghci/ghci-wrapper.cabal.in
=====================================
@@ -29,4 +29,4 @@ Executable ghci
-- We need to call the versioned ghc executable because the unversioned
-- GHC executable is a wrapper that doesn't call FreeConsole and so
-- breaks an interactive process like GHCi. See #21889, #14150 and #13411
- CPP-Options: -DEXE_PATH="ghc- at ProjectVersion@"
+ cc-options: -DEXE_PATH="ghc- at ProjectVersion@"
=====================================
hadrian/src/Rules/BinaryDist.hs
=====================================
@@ -515,8 +515,8 @@ createVersionWrapper pkg versioned_exe install_path = do
| otherwise = 0
cmd ghcPath (["-no-hs-main", "-o", install_path, "-I"++version_wrapper_dir
- , "-DEXE_PATH=\"" ++ versioned_exe ++ "\""
- , "-DINTERACTIVE_PROCESS=" ++ show interactive
+ , "-optc-DEXE_PATH=\"" ++ versioned_exe ++ "\""
+ , "-optc-DINTERACTIVE_PROCESS=" ++ show interactive
] ++ wrapper_files)
{-
=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -297,14 +297,11 @@ rtsPackageArgs = package rts ? do
libzstdIncludeDir <- getSetting LibZstdIncludeDir
libzstdLibraryDir <- getSetting LibZstdLibDir
+
-- Arguments passed to GHC when compiling C and .cmm sources.
let ghcArgs = mconcat
[ arg "-Irts"
, arg $ "-I" ++ path
- , arg $ "-DRtsWay=\"rts_" ++ show way ++ "\""
- -- Set the namespace for the rts fs functions
- , arg $ "-DFS_NAMESPACE=rts"
- , arg $ "-DCOMPILING_RTS"
, notM targetSupportsSMP ? arg "-DNOSMP"
, way `elem` [debug, debugDynamic] ? pure [ "-DTICKY_TICKY"
, "-optc-DTICKY_TICKY"]
@@ -333,9 +330,16 @@ rtsPackageArgs = package rts ? do
, "-fno-omit-frame-pointer"
, "-g3"
, "-O0" ]
+ -- Set the namespace for the rts fs functions
+ , arg $ "-DFS_NAMESPACE=rts"
+
+ , arg $ "-DCOMPILING_RTS"
, inputs ["**/RtsMessages.c", "**/Trace.c"] ?
- arg ("-DProjectVersion=" ++ show projectVersion)
+ pure
+ ["-DProjectVersion=" ++ show projectVersion
+ , "-DRtsWay=\"rts_" ++ show way ++ "\""
+ ]
, input "**/RtsUtils.c" ? pure
[ "-DProjectVersion=" ++ show projectVersion
@@ -353,6 +357,7 @@ rtsPackageArgs = package rts ? do
, "-DTargetVendor=" ++ show targetVendor
, "-DGhcUnregisterised=" ++ show ghcUnreg
, "-DTablesNextToCode=" ++ show ghcEnableTNC
+ , "-DRtsWay=\"rts_" ++ show way ++ "\""
]
-- We're after pur performance here. So make sure fast math and
=====================================
rts/sm/NonMoving.c
=====================================
@@ -151,9 +151,9 @@ static void nonmovingBumpEpoch(void) {
* 3. [STW] Root collection: Here we walk over a variety of root sources
* and add them to the mark queue (see nonmovingCollect).
*
- * 4. [CONC] Concurrent marking: Here we do the majority of marking concurrently
- * with mutator execution (but with the write barrier enabled; see
- * Note [Update remembered set]).
+ * 4. [CONC] Concurrent marking: Here we do the majority of marking
+ * concurrently with mutator execution (but with the write barrier enabled;
+ * see Note [Update remembered set]).
*
* 5. [STW] Final sync: Here we interrupt the mutators, ask them to
* flush their final update remembered sets, and mark any new references
@@ -218,9 +218,9 @@ static void nonmovingBumpEpoch(void) {
* - Note [Concurrent read barrier on deRefWeak#] (NonMovingMark.c) describes
* the read barrier on Weak# objects.
*
- * - Note [Unintentional marking in resurrectThreads] (NonMovingMark.c) describes
- * a tricky interaction between the update remembered set flush and weak
- * finalization.
+ * - Note [Unintentional marking in resurrectThreads] (NonMovingMark.c)
+ * describes a tricky interaction between the update remembered set flush and
+ * weak finalization.
*
* - Note [Origin references in the nonmoving collector] (NonMovingMark.h)
* describes how we implement indirection short-cutting and the selector
@@ -229,8 +229,8 @@ static void nonmovingBumpEpoch(void) {
* - Note [StgStack dirtiness flags and concurrent marking] (TSO.h) describes
* the protocol for concurrent marking of stacks.
*
- * - Note [Nonmoving write barrier in Perform{Put,Take}] (PrimOps.cmm) describes
- * a tricky barrier necessary when resuming threads blocked on MVar
+ * - Note [Nonmoving write barrier in Perform{Put,Take}] (PrimOps.cmm)
+ * describes a tricky barrier necessary when resuming threads blocked on MVar
* operations.
*
* - Note [Static objects under the nonmoving collector] (Storage.c) describes
@@ -240,13 +240,17 @@ static void nonmovingBumpEpoch(void) {
* how we use the DIRTY flags associated with MUT_VARs and TVARs to improve
* barrier efficiency.
*
- * - Note [Weak pointer processing and the non-moving GC] (MarkWeak.c) describes
- * how weak pointers are handled when the non-moving GC is in use.
+ * - Note [Weak pointer processing and the non-moving GC] (MarkWeak.c)
+ * describes how weak pointers are handled when the non-moving GC is in use.
*
* - Note [Sync phase marking budget] describes how we avoid long mutator
* pauses during the sync phase
*
- * - Note [Allocator sizes] goes into detail about our choice of allocator sizes.
+ * - Note [Allocator sizes] goes into detail about our choice of allocator
+ * sizes.
+ *
+ * - Note [Testing the nonmoving collector] describes how we test the
+ * collector.
*
* [ueno 2016]:
* Katsuhiro Ueno and Atsushi Ohori. 2016. A fully concurrent garbage
@@ -259,15 +263,15 @@ static void nonmovingBumpEpoch(void) {
* Concurrency-control of non-moving garbage collection is a bit tricky. There
* are a few things to keep in mind:
*
- * - Only one non-moving collection may be active at a time. This is enforced by the
- * concurrent_coll_running flag, which is set when a collection is on-going. If
- * we attempt to initiate a new collection while this is set we wait on the
- * concurrent_coll_finished condition variable, which signals when the
- * active collection finishes.
+ * - Only one non-moving collection may be active at a time. This is enforced
+ * by the concurrent_coll_running flag, which is set when a collection is
+ * on-going. If we attempt to initiate a new collection while this is set we
+ * wait on the concurrent_coll_finished condition variable, which signals
+ * when the active collection finishes.
*
- * - In between the mark and sweep phases the non-moving collector must synchronize
- * with mutator threads to collect and mark their final update remembered
- * sets. This is accomplished using
+ * - In between the mark and sweep phases the non-moving collector must
+ * synchronize with mutator threads to collect and mark their final update
+ * remembered sets. This is accomplished using
* stopAllCapabilitiesWith(SYNC_FLUSH_UPD_REM_SET). Capabilities are held
* the final mark has concluded.
*
@@ -361,9 +365,9 @@ static void nonmovingBumpEpoch(void) {
* ╰─────────────────╯
* ┆
*
- * In this case we have a TSO blocked on a dead MVar. Because the MVAR_TSO_QUEUE on
- * which it is blocked lives in the moving heap, the TSO is necessarily on the
- * oldest generation's mut_list. As in Note [Aging under the non-moving
+ * In this case we have a TSO blocked on a dead MVar. Because the MVAR_TSO_QUEUE
+ * on which it is blocked lives in the moving heap, the TSO is necessarily on
+ * the oldest generation's mut_list. As in Note [Aging under the non-moving
* collector], the MVAR_TSO_QUEUE will be evacuated. If MVAR_TSO_QUEUE is aged
* (e.g. evacuated to the young generation) then the MVAR will be added to the
* mark queue. Consequently, we will falsely conclude that the MVAR is still
@@ -387,9 +391,9 @@ static void nonmovingBumpEpoch(void) {
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
* The nonmoving collector uses an approximate heuristic for reporting live
* data quantity. Specifically, during mark we record how much live data we
- * find in nonmoving_segment_live_words. At the end of mark this is combined with nonmoving_large_words
- * and nonmoving_compact_words, and we declare this amount to
- * be how much live data we have on in the nonmoving heap (by setting
+ * find in nonmoving_segment_live_words. At the end of mark this is combined
+ * with nonmoving_large_words and nonmoving_compact_words, and we declare this
+ * amount to be how much live data we have on in the nonmoving heap (by setting
* oldest_gen->live_estimate).
*
* In addition, we update oldest_gen->live_estimate every time we fill a
@@ -413,10 +417,10 @@ static void nonmovingBumpEpoch(void) {
* - Minor collections assume that all sparks living in the non-moving heap
* are reachable.
*
- * - Major collections prune the spark queue during the final sync. This pruning
- * assumes that all sparks in the young generations are reachable (since the
- * BF_EVACUATED flag won't be set on the nursery blocks) and will consequently
- * only prune dead sparks living in the non-moving heap.
+ * - Major collections prune the spark queue during the final sync. This
+ * pruning assumes that all sparks in the young generations are reachable (since
+ * the BF_EVACUATED flag won't be set on the nursery blocks) and will
+ * consequently only prune dead sparks living in the non-moving heap.
*
*
* Note [Dirty flags in the non-moving collector]
@@ -439,8 +443,8 @@ static void nonmovingBumpEpoch(void) {
* In the non-moving collector we use the same dirty flag to implement a
* related optimisation on the non-moving write barrier: Specifically, the
* snapshot invariant only requires that the non-moving write barrier applies
- * to the *first* mutation to an object after collection begins. To achieve this,
- * we impose the following invariant:
+ * to the *first* mutation to an object after collection begins. To achieve
+ * this, we impose the following invariant:
*
* An object being marked as dirty implies that all of its fields are on
* the mark queue (or, equivalently, update remembered set).
@@ -492,8 +496,8 @@ static void nonmovingBumpEpoch(void) {
* ┊
*
* This is bad. When we resume mutation a mutator may mutate MVAR A; since it's
- * already dirty we would fail to add Y to the update remembered set, breaking the
- * snapshot invariant and potentially losing track of the liveness of Z.
+ * already dirty we would fail to add Y to the update remembered set, breaking
+ * the snapshot invariant and potentially losing track of the liveness of Z.
*
* To avoid this nonmovingScavengeOne we eagerly pushes the values of the
* fields of all objects which it fails to evacuate (e.g. MVAR A) to the update
@@ -535,8 +539,9 @@ static void nonmovingBumpEpoch(void) {
* Note [Allocator sizes]
* ~~~~~~~~~~~~~~~~~~~~~~
* Our choice of allocator sizes has to balance several considerations:
- * - Allocator sizes should be available for the most commonly request block sizes,
- * in order to avoid excessive waste from rounding up to the next size (internal fragmentation).
+ * - Allocator sizes should be available for the most commonly request block
+ * sizes, in order to avoid excessive waste from rounding up to the next size
+ * (internal fragmentation).
* - It should be possible to efficiently determine which allocator services
* a certain block size.
* - The amount of allocators should be kept down to avoid overheads
@@ -548,18 +553,37 @@ static void nonmovingBumpEpoch(void) {
* arbitrary allocator sizes, we need to do some precomputation and make
* use of the integer division by constants optimisation.
*
- * We currenlty try to balance these considerations by adopting the following scheme.
- * We have nonmoving_alloca_dense_cnt "dense" allocators starting with size
- * NONMOVING_ALLOCA0, and incrementing by NONMOVING_ALLOCA_DENSE_INCREMENT.
+ * We currenlty try to balance these considerations by adopting the following
+ * scheme. We have nonmoving_alloca_dense_cnt "dense" allocators starting with
+ * size NONMOVING_ALLOCA0, and incrementing by NONMOVING_ALLOCA_DENSE_INCREMENT.
* These service the vast majority of allocations.
* In practice, Haskell programs tend to allocate a lot of small objects.
*
- * Other allocations are handled by a family of "sparse" allocators, each providing
- * blocks up to a power of 2. This places an upper bound on the waste at half the
- * required block size.
+ * Other allocations are handled by a family of "sparse" allocators, each
+ * providing blocks up to a power of 2. This places an upper bound on the waste
+ * at half the required block size.
*
* See #23340
*
+ *
+ * Note [Testing the nonmoving collector]
+ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ * The testsuite has four "ways" which test the nonmoving collector:
+ *
+ * - nonmoving: runs tests under the nonmoving collector running in
+ * non-concurrent mode (i.e. using the non-threaded runtime)
+ * - nonmoving_thr: runs tests under the collector running in concurrent
+ * mode (with the threaded runtime)
+ * - nonmoving_thr_sanity: runs tests with concurrent collection and
+ * sanity checking (i.e. `+RTS -DS`)
+ * - nonmoving_thr_ghc: compiles tests with `ghc +RTS --nonmoving-gc -RTS`
+ * as GHC itself tends to be a good smoke test of the collector.
+ *
+ * To avoid blowing up validation times, we do not run any of these ways in the
+ * default "normal" test speed. To ensure that we catch regressions in during
+ * normal validation we do run a small number of tests in these ways. These
+ * tests are identified by the `nonmoving_test` test modifier.
+ *
*/
memcount nonmoving_segment_live_words = 0;
=====================================
rts/sm/NonMoving.h
=====================================
@@ -17,13 +17,13 @@
#include "BeginPrivate.h"
// Segments
-#define NONMOVING_SEGMENT_BITS 15UL // 2^15 = 32kByte
+#define NONMOVING_SEGMENT_BITS 15ULL // 2^15 = 32kByte
// Mask to find base of segment
-#define NONMOVING_SEGMENT_MASK ((1UL << NONMOVING_SEGMENT_BITS) - 1)
+#define NONMOVING_SEGMENT_MASK (((uintptr_t)1 << NONMOVING_SEGMENT_BITS) - 1)
// In bytes
-#define NONMOVING_SEGMENT_SIZE (1UL << NONMOVING_SEGMENT_BITS)
+#define NONMOVING_SEGMENT_SIZE ((uintptr_t)1 << NONMOVING_SEGMENT_BITS)
// In words
-#define NONMOVING_SEGMENT_SIZE_W ((1UL << NONMOVING_SEGMENT_BITS) / SIZEOF_VOID_P)
+#define NONMOVING_SEGMENT_SIZE_W (((uintptr_t)1 << NONMOVING_SEGMENT_BITS) / SIZEOF_VOID_P)
// In blocks
#define NONMOVING_SEGMENT_BLOCKS (NONMOVING_SEGMENT_SIZE / BLOCK_SIZE)
=====================================
testsuite/driver/testlib.py
=====================================
@@ -149,6 +149,15 @@ def js_broken( bug: IssueNumber ):
else:
return normal;
+def nonmoving_test( name, opts ):
+ """
+ Always run the given test with the nonmoving collector, in addition to
+ the usual ways.
+
+ See Note [Testing the nonmoving collector] in rts/sm/NonMoving.c.
+ """
+ return extra_ways(['nonmoving', 'nonmoving_thr_sanity', 'nonmoving_thr_ghc'])(name, opts)
+
def expect_fail( name, opts ):
# The compiler, testdriver, OS or platform is missing a certain
# feature, and we don't plan to or can't fix it now or in the
@@ -1023,8 +1032,8 @@ def normalise_win32_io_errors(name, opts):
def normalise_version_( *pkgs ):
def normalise_version__( str ):
# (name)(-version)(-hash)(-components)
- return re.sub('(' + '|'.join(map(re.escape,pkgs)) + ')-[0-9.]+(-[0-9a-zA-Z\+]+)?(-[0-9a-zA-Z]+)?',
- '\\1-<VERSION>-<HASH>', str)
+ return re.sub('(' + '|'.join(map(re.escape,pkgs)) + r')-[0-9.]+(-[0-9a-zA-Z\+]+)?(-[0-9a-zA-Z]+)?',
+ r'\1-<VERSION>-<HASH>', str)
return normalise_version__
def normalise_version( *pkgs ):
=====================================
testsuite/tests/array/should_run/all.T
=====================================
@@ -21,6 +21,6 @@ test('arr014', when(fast(), skip), compile_and_run, [''])
test('arr015', when(fast(), skip), compile_and_run, [''])
test('arr017', when(fast(), skip), compile_and_run, [''])
test('arr018', when(fast(), skip), compile_and_run, [''])
-test('arr019', normal, compile_and_run, [''])
-test('arr020', normal, compile_and_run, [''])
+test('arr019', nonmoving_test, compile_and_run, [''])
+test('arr020', nonmoving_test, compile_and_run, [''])
test('T21962', normal, compile_and_run, [''])
=====================================
testsuite/tests/concurrent/should_run/all.T
=====================================
@@ -1,18 +1,18 @@
# -----------------------------------------------------------------------------
# These tests we do even for 'make fast'
-test('conc003', normal, compile_and_run, [''])
-test('conc006', normal, compile_and_run, [''])
-test('conc027', normal, compile_and_run, [''])
-test('conc051', normal, compile_and_run, [''])
+test('conc003', nonmoving_test, compile_and_run, [''])
+test('conc006', nonmoving_test, compile_and_run, [''])
+test('conc027', nonmoving_test, compile_and_run, [''])
+test('conc051', nonmoving_test, compile_and_run, [''])
if ('threaded1' in config.run_ways):
only_threaded_ways = only_ways(['ghci','threaded1','threaded2', 'nonmoving_thr'])
else:
only_threaded_ways = skip
-test('conc069', only_threaded_ways, compile_and_run, [''])
-test('conc069a', only_threaded_ways, compile_and_run, [''])
+test('conc069', [nonmoving_test, only_threaded_ways], compile_and_run, [''])
+test('conc069a', [nonmoving_test, only_threaded_ways], compile_and_run, [''])
# this test gives slightly different results for non-threaded ways, so omit
# those for now.
test('conc070', only_threaded_ways, compile_and_run, [''])
@@ -47,8 +47,8 @@ test('T3429', [ extra_run_opts('+RTS -C0.001 -RTS'),
# times out with ghci
test('T4030', omit_ghci, compile_and_run, ['-O'])
-test('throwto002', normal, compile_and_run, [''])
-test('throwto003', normal, compile_and_run, [''])
+test('throwto002', nonmoving_test, compile_and_run, [''])
+test('throwto003', nonmoving_test, compile_and_run, [''])
test('mask001', normal, compile_and_run, [''])
test('mask002', js_broken(22261), compile_and_run, [''])
@@ -81,9 +81,9 @@ test('T5611a', fragile(12751), compile_and_run, [''])
test('T5238', normal, compile_and_run, [''])
test('T5866', exit_code(1), compile_and_run, [''])
-test('readMVar1', normal, compile_and_run, [''])
-test('readMVar2', normal, compile_and_run, [''])
-test('readMVar3', normal, compile_and_run, [''])
+test('readMVar1', nonmoving_test, compile_and_run, [''])
+test('readMVar2', nonmoving_test, compile_and_run, [''])
+test('readMVar3', nonmoving_test, compile_and_run, [''])
test('tryReadMVar1', normal, compile_and_run, [''])
test('tryReadMVar2', normal, compile_and_run, [''])
@@ -121,9 +121,9 @@ test('allocLimit4', [ extra_run_opts('+RTS -xq300k -RTS'),
setTestOpts(when(fast(), skip))
-test('conc001', normal, compile_and_run, [''])
-test('conc002', normal, compile_and_run, [''])
-test('conc004', normal, compile_and_run, [''])
+test('conc001', nonmoving_test, compile_and_run, [''])
+test('conc002', nonmoving_test, compile_and_run, [''])
+test('conc004', nonmoving_test, compile_and_run, [''])
test('conc007', extra_run_opts('+RTS -H128M -RTS'), compile_and_run, [''])
test('conc008', normal, compile_and_run, [''])
test('conc009', exit_code(1), compile_and_run, [''])
@@ -218,16 +218,17 @@ test('conc039', [omit_ways(ghci_ways + threaded_ways), js_skip], compile_and_run
test('conc040', [exit_code(1), omit_ghci, js_skip], compile_and_run, [''])
# STM-related tests.
-test('conc041', normal, compile_and_run, [''])
-test('conc042', normal, compile_and_run, [''])
-test('conc043', normal, compile_and_run, [''])
-test('conc044', normal, compile_and_run, [''])
-test('conc045', normal, compile_and_run, [''])
+test('conc041', nonmoving_test, compile_and_run, [''])
+test('conc042', nonmoving_test, compile_and_run, [''])
+test('conc043', nonmoving_test, compile_and_run, [''])
+test('conc044', nonmoving_test, compile_and_run, [''])
+test('conc045', nonmoving_test, compile_and_run, [''])
-test('conc058', normal, compile_and_run, [''])
+test('conc058', nonmoving_test, compile_and_run, [''])
test('conc059',
[only_ways(['threaded1', 'threaded2', 'nonmoving_thr']),
+ nonmoving_test,
pre_cmd('$MAKE -s --no-print-directory conc059_setup')],
compile_and_run, ['conc059_c.c -no-hs-main'])
=====================================
testsuite/tests/driver/T16737.hs deleted
=====================================
@@ -1,32 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# OPTIONS_GHC -DFOO=2 -optP=-DBAR=3 -optc=-DBAZ=5 -optcxx=-DBAZ=7 #-}
-
-import Language.Haskell.TH.Syntax
-
-do
- let code = unlines
- [ "#if defined(__cplusplus)"
- , "extern \"C\" {"
- , "#endif"
- , "#include <T16737.h>"
- , "int FUN(void) {"
- , " return FOO * BAR * BAZ;"
- , "}"
- , "#if defined(__cplusplus)"
- , "}"
- , "#endif"
- ]
- addForeignSource LangC code
- addForeignSource LangCxx code
- pure []
-
-foreign import ccall unsafe "c_value"
- c_value :: IO Int
-
-foreign import ccall unsafe "cxx_value"
- cxx_value :: IO Int
-
-main :: IO ()
-main = do
- print =<< c_value
- print =<< cxx_value
=====================================
testsuite/tests/driver/T16737.stdout deleted
=====================================
@@ -1,2 +0,0 @@
-30
-42
=====================================
testsuite/tests/driver/T16737include/T16737.h deleted
=====================================
@@ -1,7 +0,0 @@
-#pragma once
-
-#if defined(__cplusplus)
-#define FUN cxx_value
-#else
-#define FUN c_value
-#endif
=====================================
testsuite/tests/driver/all.T
=====================================
@@ -285,12 +285,6 @@ test('inline-check', [omit_ways(['hpc', 'profasm'])]
test('T14452', js_broken(22261), makefile_test, [])
test('T14923', normal, makefile_test, [])
test('T15396', normal, compile_and_run, ['-package ghc'])
-test('T16737',
- [extra_files(['T16737include/']),
- req_th,
- req_c,
- expect_broken_for(16541, ghci_ways)],
- compile_and_run, ['-optP=-isystem -optP=T16737include'])
test('T17143', exit_code(1), run_command, ['{compiler} T17143.hs -S -fno-code'])
test('T17786', unless(opsys('mingw32'), skip), makefile_test, [])
=====================================
testsuite/tests/hpc/T17073.stdout
=====================================
@@ -7,7 +7,7 @@
100% alternatives used (0/0)
100% local declarations used (0/0)
100% top-level declarations used (1/1)
-hpc tools, version 0.68
+hpc tools, version 0.69
Writing: Main.hs.html
Writing: hpc_index.html
Writing: hpc_index_fun.html
=====================================
testsuite/tests/simplCore/should_compile/T21348.hs
=====================================
@@ -0,0 +1,97 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module T21348 where
+
+import qualified Data.Map as M
+import Data.Kind (Type)
+
+newtype Parser a = Parser {
+ runParser :: () -> (a -> Int) -> Int
+ } deriving (Functor)
+
+instance Applicative Parser where
+ pure a = Parser $ \_path ks -> ks a
+ {-# INLINE pure #-}
+ (<*>) m e = Parser $ \path ks -> let ks' a = runParser (a <$> e) path ks
+ in runParser m path ks'
+ {-# INLINE (<*>) #-}
+
+data Value = Object (M.Map String Value) | Unused
+
+class FromJSON a where
+ parseJSON :: Value -> Parser a
+ _unused :: a -> a
+
+instance FromJSON Bool where
+ parseJSON _ = pure False
+ _unused = id
+
+data Pa a = MkPa Bool a
+
+class RecordFromJSON f where
+ recordParseJSON :: () -> M.Map String Value -> Parser (Pa f)
+
+class RecordFromJSON2 f where
+ recordParseJSON2 :: M.Map String Value -> Parser f
+
+instance (RecordFromJSON2 b) => RecordFromJSON b where
+ recordParseJSON _ obj = MkPa <$> pure False
+ <*> recordParseJSON2 obj
+ {-# INLINE recordParseJSON #-}
+
+instance (FromJSON a) => RecordFromJSON2 a where
+ recordParseJSON2 obj = pure () *> (id <$> (id <$> parseJSON (obj M.! "x")))
+ {-# INLINE recordParseJSON2 #-}
+
+data Rec :: [Type] -> Type where
+ RNil :: Rec '[]
+ RCons :: Field r -> Rec rs -> Rec (r ': rs)
+
+data Rec2 :: [Type] -> Type where
+ RNil2 :: Rec2 '[]
+ RCons2 :: DocField r -> Rec2 rs -> Rec2 (r ': rs)
+
+data Field x = Field x
+
+newtype DocField x = DocField (Field x)
+
+instance FromJSON (Rec '[]) where
+ parseJSON _ = undefined
+ _unused = id
+
+instance (FromJSON t, FromJSON (Rec rs)) => FromJSON (Rec (t ': rs)) where
+ parseJSON v = rebuild <$> parseJSON v <*> parseJSON v
+ where rebuild m rest = Field m `RCons` rest
+ _unused = id
+
+instance (RMap rs, FromJSON (Rec rs)) => FromJSON (Rec2 rs) where
+ parseJSON v = rmap DocField <$> parseJSON v
+ _unused = id
+
+class RMap rs where
+ rmap :: (forall x. Field x -> DocField x) -> Rec rs -> Rec2 rs
+
+instance RMap '[] where
+ rmap _ RNil = RNil2
+ {-# INLINE rmap #-}
+
+instance RMap xs => RMap (x ': xs) where
+ rmap f (x `RCons` xs) = f x `RCons2` rmap f xs
+ {-# INLINE rmap #-}
+
+g :: RecordFromJSON a => Value -> Parser (Pa a)
+g (Object r) = recordParseJSON () r
+g Unused = undefined
+
+bug :: Value -> Parser (Pa (Rec2 '[Bool, Bool, Bool, Bool]))
+bug = g
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -503,3 +503,4 @@ test('T23922a', normal, compile, ['-O'])
test('T23952', [extra_files(['T23952a.hs'])], multimod_compile, ['T23952', '-v0 -O'])
test('T24014', normal, compile, ['-dcore-lint'])
test('T24029', normal, compile, [''])
+test('T21348', normal, compile, ['-O'])
=====================================
testsuite/tests/th/T24046.hs
=====================================
@@ -0,0 +1,19 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module T24046 where
+
+import Language.Haskell.TH.Syntax
+
+-- Test added in relation to this issue: https://gitlab.haskell.org/ghc/ghc/-/issues/24046
+
+{-# NOINLINE foo #-}
+foo = undefined
+
+$( let simplerule = [PragmaD $ RuleP "rejected-rule" Nothing foralld lhs rhs AllPhases]
+
+ foralld = [RuleVar $ mkName "x", RuleVar $ mkName "y"]
+
+ lhs = AppE (AppE (VarE $ mkName "foo") (VarE $ mkName "x")) (VarE $ mkName "y")
+
+ rhs = AppE (AppE (VarE $ mkName "foo") (VarE $ mkName "y")) (VarE $ mkName "x")
+ in return simplerule)
=====================================
testsuite/tests/th/all.T
=====================================
@@ -146,6 +146,7 @@ test('T2817', normal, compile, ['-v0'])
test('T2713', normal, compile_fail, ['-v0'])
test('T2674', normal, compile_fail, ['-v0'])
test('TH_emptycase', normal, compile, ['-v0'])
+test('T24046', normal, compile, ['-v0'])
test('T2386', [only_ways(['normal'])], makefile_test, ['T2386'])
=====================================
utils/hpc
=====================================
@@ -1 +1 @@
-Subproject commit 2d75eb33d4c179b1c21000d32c2906ad273de0de
+Subproject commit 4b46380a06c16e38a5b9d623ab85538ee4b2319d
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/34f927525bdc679ac56f53993c7911bcf5f68832...742d819d67371ba2cbb6c49a0cf29ffdec69e2cd
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/34f927525bdc679ac56f53993c7911bcf5f68832...742d819d67371ba2cbb6c49a0cf29ffdec69e2cd
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/20231005/f088718c/attachment-0001.html>
More information about the ghc-commits
mailing list