[Git][ghc/ghc][wip/js-staging] 2 commits: Enable more tests that were "unexpected passes"
Sylvain Henry (@hsyl20)
gitlab at gitlab.haskell.org
Fri Nov 4 16:34:17 UTC 2022
Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC
Commits:
bcb32644 by Sylvain Henry at 2022-11-04T17:37:00+01:00
Enable more tests that were "unexpected passes"
- - - - -
69acf685 by Sylvain Henry at 2022-11-04T17:37:26+01:00
Take cross into account in perf and ticky flavours
- - - - -
13 changed files:
- hadrian/bindist/config.mk.in
- hadrian/doc/flavours.md
- hadrian/src/Expression.hs
- hadrian/src/Flavour.hs
- hadrian/src/Settings/Default.hs
- hadrian/src/Settings/Flavours/Performance.hs
- libraries/base/tests/all.T
- libraries/stm
- testsuite/tests/codeGen/should_run/all.T
- testsuite/tests/driver/T20030/test1/all.T
- testsuite/tests/primops/should_run/all.T
- testsuite/tests/rts/pause-resume/all.T
- testsuite/tests/rts/pause-resume/shouldfail/all.T
Changes:
=====================================
hadrian/bindist/config.mk.in
=====================================
@@ -128,6 +128,8 @@ GhcUnregisterised = @Unregisterised@
ifeq "$(TargetArch_CPP)" "arm"
# We don't support load/store barriers pre-ARMv7. See #10433.
ArchSupportsSMP=$(if $(filter $(ARM_ISA),ARMv5 ARMv6),NO,YES)
+else ifeq "$(TargetArch_CPP)" "js"
+ArchSupportsSMP=NO
else
ArchSupportsSMP=$(strip $(patsubst $(TargetArch_CPP), YES, $(findstring $(TargetArch_CPP), i386 x86_64 sparc powerpc powerpc64 powerpc64le s390x aarch64 riscv64)))
endif
=====================================
hadrian/doc/flavours.md
=====================================
@@ -211,15 +211,6 @@ The supported transformers are listed below:
<td><code>ticky_ghc</code></td>
<td>Compile the GHC executable with Ticky-Ticky profiler support.</td>
</tr>
- <tr>
- <td><code>ticky_ghc0</code></td>
- <td>Compile the stage0 GHC executable with Ticky-Ticky profiler support. Useful for cross-compilers, which are always stage1 compilers</td>
- </tr>
- <tr>
- <td><code>perf_stage0</code></td>
- <td>Ensure that the `-O2` flags are passed to the stage0 build thus yielding an optimised stage1 compiler. Useful for cross-compilers, which are always stage1 compilers
- </td>
- </tr>
<tr>
<td><code>split_sections</code></td>
<td>Enable section splitting for all libraries (except for the GHC
=====================================
hadrian/src/Expression.hs
=====================================
@@ -9,7 +9,7 @@ module Expression (
-- ** Predicates
(?), stage, stage0, stage1, stage2, notStage0, threadedBootstrapper,
- package, notPackage, packageOneOf,
+ package, notPackage, packageOneOf, cross, notCross,
libraryPackage, builder, way, input, inputs, output, outputs,
-- ** Evaluation
@@ -151,3 +151,9 @@ cabalFlag pred flagName = do
ifM (toPredicate pred) (arg flagName) (arg $ "-"<>flagName)
infixr 3 `cabalFlag`
+
+cross :: Predicate
+cross = expr (flag CrossCompiling)
+
+notCross :: Predicate
+notCross = notM cross
=====================================
hadrian/src/Flavour.hs
=====================================
@@ -10,7 +10,6 @@ module Flavour
, enableDebugInfo, enableTickyGhc
, viaLlvmBackend
, enableProfiledGhc
- , perfStage0
, disableDynamicGhcPrograms
, disableDynamicLibs
, disableProfiledLibs
@@ -39,15 +38,11 @@ import Control.Monad.Except
import UserSettings
import Oracles.Setting
-import {-# SOURCE #-} Settings.Default
-
flavourTransformers :: Map String (Flavour -> Flavour)
flavourTransformers = M.fromList
[ "werror" =: werror
, "debug_info" =: enableDebugInfo
, "ticky_ghc" =: enableTickyGhc
- , "ticky_ghc0" =: enableTickyGhc0
- , "perf_stage0" =: perfStage0
, "split_sections" =: splitSections
, "thread_sanitizer" =: enableThreadSanitizer
, "llvm" =: viaLlvmBackend
@@ -131,31 +126,7 @@ enableDebugInfo = addArgs $ notStage0 ? mconcat
-- | Enable the ticky-ticky profiler in stage2 GHC
enableTickyGhc :: Flavour -> Flavour
enableTickyGhc =
- addArgs $ stage1 ? mconcat
- [ builder (Ghc CompileHs) ? tickyArgs
- , builder (Ghc LinkHs) ? tickyArgs
- ]
-
--- | Enable the ticky-ticky profiler in stage1 GHC
-perfStage0 :: Flavour -> Flavour
-perfStage0 fl = addArgs args fl
- -- This is a bit sloppy because it does not preclude any predicates that turn
- -- on (or off) optimizations that were added be the flavor or by another
- -- transformer. Luckily though if we're using this transformer then we want O2
- -- for each subsequent stage and ghc doesn't choke on the redundant flags
- -- There is the remove in Hadrian.Expression but it doesn't handle predicates
- where
- args = sourceArgs SourceArgs
- { hsDefault = mconcat [ arg "-O2", arg "-H64m"]
- , hsLibrary = arg "-O2"
- , hsCompiler = arg "-O2"
- , hsGhc = arg "-O2"
- }
-
--- | Enable the ticky-ticky profiler in stage1 GHC
-enableTickyGhc0 :: Flavour -> Flavour
-enableTickyGhc0 =
- addArgs $ stage0 ? mconcat
+ addArgs $ orM [stage1, cross] ? mconcat
[ builder (Ghc CompileHs) ? tickyArgs
, builder (Ghc LinkHs) ? tickyArgs
]
=====================================
hadrian/src/Settings/Default.hs
=====================================
@@ -176,10 +176,13 @@ defaultLibraryWays = Set.fromList <$>
defaultRtsWays :: Ways
defaultRtsWays = Set.fromList <$>
mconcat
- [ pure [vanilla, threaded]
+ [ pure [vanilla]
+ , targetSupportsSMP ? pure [threaded]
, notStage0 ? pure
- [ profiling, threadedProfiling, debugProfiling, threadedDebugProfiling
- , debug, threadedDebug
+ [ profiling, debugProfiling, debug
+ ]
+ , notStage0 ? targetSupportsSMP ? pure
+ [ threadedProfiling, threadedDebugProfiling, threadedDebug
]
, notStage0 ? platformSupportsSharedLibs ? pure
[ dynamic, threadedDynamic, debugDynamic, threadedDebugDynamic
=====================================
hadrian/src/Settings/Flavours/Performance.hs
=====================================
@@ -13,6 +13,10 @@ performanceFlavour = defaultFlavour
performanceArgs :: Args
performanceArgs = sourceArgs SourceArgs
{ hsDefault = pure ["-O", "-H64m"]
- , hsLibrary = notStage0 ? arg "-O2"
+ , hsLibrary = orM [notStage0, cross] ? arg "-O2"
, hsCompiler = pure ["-O2"]
- , hsGhc = mconcat [stage0 ? arg "-O", notStage0 ? arg "-O2"] }
+ , hsGhc = mconcat
+ [ andM [stage0, notCross] ? arg "-O"
+ , orM [notStage0, cross] ? arg "-O2"
+ ]
+ }
=====================================
libraries/base/tests/all.T
=====================================
@@ -240,7 +240,7 @@ test('T11555', normal, compile_and_run, [''])
test('T12494', normal, compile_and_run, [''])
test('T12852', [when(opsys('mingw32'), skip), js_broken(22374)], compile_and_run, [''])
test('lazySTexamples', normal, compile_and_run, [''])
-test('T11760', [req_smp, js_broken(22261)], compile_and_run, ['-threaded -with-rtsopts=-N2'])
+test('T11760', req_smp, compile_and_run, ['-threaded -with-rtsopts=-N2'])
test('T12874', normal, compile_and_run, [''])
test('T13191',
[ collect_stats('bytes allocated', 5)
=====================================
libraries/stm
=====================================
@@ -1 +1 @@
-Subproject commit 41c9eca2351bb2fbbf0837f3a7569325f327be6a
+Subproject commit 9bc0321c32f67888103a2b9a200f224ab408a79b
=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -156,7 +156,7 @@ test('T10246', normal, compile_and_run, [''])
test('T9533', normal, compile_and_run, [''])
test('T9533b', normal, compile_and_run, [''])
test('T9533c', normal, compile_and_run, [''])
-test('T10414', [only_ways(['threaded2']), extra_ways(['threaded2']), req_smp, js_broken(22261)],
+test('T10414', [only_ways(['threaded2']), extra_ways(['threaded2']), req_smp],
compile_and_run, ['-feager-blackholing'])
test('T10521', normal, compile_and_run, [''])
test('T10521b', normal, compile_and_run, [''])
=====================================
testsuite/tests/driver/T20030/test1/all.T
=====================================
@@ -10,6 +10,5 @@ test('T20030_test1j',
, 'D.hs' , 'E.hs-boot' , 'E.hs' , 'F.hs' , 'G.hs' , 'H.hs'
, 'I.hs', 'J.hs-boot', 'J.hs', 'K.hs' ])
, req_smp
- , js_broken(22261)
],
multimod_compile, ['I.hs K.hs', '-v1 -j'])
=====================================
testsuite/tests/primops/should_run/all.T
=====================================
@@ -56,7 +56,7 @@ test('UnliftedSmallArray1', normal, compile_and_run, [''])
test('UnliftedSmallArray2', normal, compile_and_run, [''])
test('UnliftedStablePtr', normal, compile_and_run, [''])
test('UnliftedTVar1', normal, compile_and_run, [''])
-test('UnliftedTVar2', js_broken(22261), compile_and_run, [''])
+test('UnliftedTVar2', normal, compile_and_run, [''])
test('UnliftedWeakPtr', normal, compile_and_run, [''])
test('T21624', normal, compile_and_run, [''])
=====================================
testsuite/tests/rts/pause-resume/all.T
=====================================
@@ -1,25 +1,30 @@
test('pause_resume_via_safe_ffi',
[ only_ways(['threaded1', 'threaded2'])
+ , req_c
, extra_files(['pause_resume.c','pause_resume.h'])
],
multi_compile_and_run, ['pause_resume_via_safe_ffi', [('pause_resume.c','')], ''])
test('pause_resume_via_pthread',
[ only_ways(['threaded1', 'threaded2'])
+ , req_c
, extra_files(['pause_resume.c','pause_resume.h'])
],
multi_compile_and_run, ['pause_resume_via_pthread', [('pause_resume.c','')], ''])
test('pause_resume_via_safe_ffi_concurrent',
[ only_ways(['threaded1', 'threaded2'])
+ , req_c
, extra_files(['pause_resume.c','pause_resume.h'])
],
multi_compile_and_run, ['pause_resume_via_safe_ffi_concurrent', [('pause_resume.c','')], ''])
test('pause_and_use_rts_api',
[ only_ways(['threaded1', 'threaded2'])
+ , req_c
, extra_files(['pause_resume.c','pause_resume.h'])
],
multi_compile_and_run, ['pause_and_use_rts_api', [('pause_resume.c','')], ''])
test('list_threads_and_misc_roots',
[ only_ways(['threaded1', 'threaded2'])
+ , req_c
, extra_files(['list_threads_and_misc_roots_c.c','list_threads_and_misc_roots_c.h'])
],
- multi_compile_and_run, ['list_threads_and_misc_roots', [('list_threads_and_misc_roots_c.c','')], ''])
\ No newline at end of file
+ multi_compile_and_run, ['list_threads_and_misc_roots', [('list_threads_and_misc_roots_c.c','')], ''])
=====================================
testsuite/tests/rts/pause-resume/shouldfail/all.T
=====================================
@@ -6,18 +6,21 @@ test('unsafe_rts_pause',
test('rts_lock_when_paused',
[ only_ways(['threaded1', 'threaded2'])
, exit_code(1)
+ , req_c
, extra_files(['rts_pause_lock.c','rts_pause_lock.h'])
],
multi_compile_and_run, ['rts_lock_when_paused', [('rts_pause_lock.c','')], ''])
test('rts_pause_when_locked',
[ only_ways(['threaded1', 'threaded2'])
, exit_code(1)
+ , req_c
, extra_files(['rts_pause_lock.c','rts_pause_lock.h'])
],
multi_compile_and_run, ['rts_pause_when_locked', [('rts_pause_lock.c','')], ''])
test('rts_double_pause',
[ only_ways(['threaded1', 'threaded2'])
, exit_code(1)
+ , req_c
, extra_files(['rts_pause_lock.c','rts_pause_lock.h'])
],
multi_compile_and_run, ['rts_double_pause', [('rts_pause_lock.c','')], ''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4a6dfe4a83165977b43e996fda15cb7876d62b84...69acf685fd1a6b1edb1f8991e4c2df613fee9581
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4a6dfe4a83165977b43e996fda15cb7876d62b84...69acf685fd1a6b1edb1f8991e4c2df613fee9581
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/20221104/98c47f34/attachment-0001.html>
More information about the ghc-commits
mailing list