[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Add support for -debug in the testsuite
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Apr 11 20:34:50 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
08567a83 by Krzysztof Gogolewski at 2023-04-11T16:34:37-04:00
Add support for -debug in the testsuite
Confusingly, GhcDebugged referred to GhcDebugAssertions.
- - - - -
d415ffa2 by Krzysztof Gogolewski at 2023-04-11T16:34:37-04:00
Add missing cases in -Di prettyprinter
Fixes #23142
- - - - -
fd75e294 by Cheng Shao at 2023-04-11T16:34:38-04:00
compiler: make WasmCodeGenM an instance of MonadUnique
- - - - -
f2484e92 by Cheng Shao at 2023-04-11T16:34:39-04:00
compiler: apply cmm node-splitting for wasm backend
This patch applies cmm node-splitting for wasm32 NCG, which is
required when handling irreducible CFGs. Fixes #23237.
- - - - -
8500bf14 by Bodigrim at 2023-04-11T16:34:42-04:00
Set base 'maintainer' field to CLC
- - - - -
e6ab90e6 by Simon Peyton Jones at 2023-04-11T16:34:42-04:00
Clarify a couple of Notes about 'nospec'
- - - - -
17 changed files:
- compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
- compiler/GHC/CmmToAsm/Wasm/Types.hs
- compiler/GHC/Core/InstEnv.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Wasm/ControlFlow/FromCmm.hs
- hadrian/src/Oracles/TestSettings.hs
- hadrian/src/Settings/Builders/RunTest.hs
- libraries/base/base.cabal
- rts/Printer.c
- testsuite/driver/testglobals.py
- testsuite/driver/testlib.py
- testsuite/ghc-config/ghc-config.hs
- testsuite/mk/test.mk
- testsuite/tests/rts/Makefile
- + testsuite/tests/rts/T23142.hs
- + testsuite/tests/rts/T23142.stdout
- testsuite/tests/rts/all.T
Changes:
=====================================
compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
=====================================
@@ -48,6 +48,7 @@ import GHC.Types.ForeignCall
import GHC.Types.Unique
import GHC.Types.Unique.FM
import GHC.Types.Unique.Map
+import GHC.Types.Unique.Supply
import GHC.Utils.Outputable hiding ((<>))
import GHC.Utils.Panic
import GHC.Wasm.ControlFlow.FromCmm
@@ -1328,7 +1329,7 @@ lower_CmmUnsafeForeignCall_Drop ::
[CmmActual] ->
WasmCodeGenM w (WasmStatements w)
lower_CmmUnsafeForeignCall_Drop lbl sym_callee ret_cmm_ty arg_exprs = do
- ret_uniq <- wasmUniq
+ ret_uniq <- getUniqueM
let ret_local = LocalReg ret_uniq ret_cmm_ty
lower_CmmUnsafeForeignCall
lbl
@@ -1528,9 +1529,11 @@ lower_CmmGraph :: CLabel -> CmmGraph -> WasmCodeGenM w (FuncBody w)
lower_CmmGraph lbl g = do
ty_word <- wasmWordTypeM
platform <- wasmPlatformM
+ us <- getUniqueSupplyM
body <-
structuredControl
platform
+ us
(\_ -> lower_CmmExpr_Typed lbl ty_word)
(lower_CmmActions lbl)
g
=====================================
compiler/GHC/CmmToAsm/Wasm/Types.hs
=====================================
@@ -45,7 +45,6 @@ module GHC.CmmToAsm.Wasm.Types
wasmStateM,
wasmModifyM,
wasmExecM,
- wasmUniq,
)
where
@@ -466,10 +465,18 @@ wasmStateM = coerce . State
wasmModifyM :: (WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
wasmModifyM = coerce . modify
+wasmEvalM :: WasmCodeGenM w a -> WasmCodeGenState w -> a
+wasmEvalM (WasmCodeGenM s) = evalState s
+
wasmExecM :: WasmCodeGenM w a -> WasmCodeGenState w -> WasmCodeGenState w
wasmExecM (WasmCodeGenM s) = execState s
-wasmUniq :: WasmCodeGenM w Unique
-wasmUniq = wasmStateM $
- \s at WasmCodeGenState {..} -> case takeUniqFromSupply wasmUniqSupply of
- (u, us) -> (# u, s {wasmUniqSupply = us} #)
+instance MonadUnique (WasmCodeGenM w) where
+ getUniqueSupplyM = wasmGetsM wasmUniqSupply
+ getUniqueM = wasmStateM $
+ \s at WasmCodeGenState {..} -> case takeUniqFromSupply wasmUniqSupply of
+ (u, us) -> (# u, s {wasmUniqSupply = us} #)
+ getUniquesM = do
+ u <- getUniqueM
+ s <- WasmCodeGenM get
+ pure $ u:(wasmEvalM getUniquesM s)
=====================================
compiler/GHC/Core/InstEnv.hs
=====================================
@@ -849,8 +849,10 @@ Here are the moving parts:
* `GHC.HsToCore.Binds.dsHsWrapper` desugars the evidence application (f d) into
(nospec f d) if `d` is incoherent. It has to do a dependency analysis to
- determine transitive dependencies, but we need to do that anway.
+ determine transitive dependencies, but we need to do that anyway.
See Note [Desugaring incoherent evidence] in GHC.HsToCore.Binds.
+
+ See also Note [nospecId magic] in GHC.Types.Id.Make.
-}
type DFunInstType = Maybe Type
=====================================
compiler/GHC/Types/Id/Make.hs
=====================================
@@ -2002,10 +2002,15 @@ Note that this happens *after* unfoldings are exposed in the interface file.
This is crucial: otherwise, we could import an unfolding in which
'nospec' has been inlined (= erased), and we would lose the benefit.
-'nospec' is used in the implementation of 'withDict': we insert 'nospec'
-so that the typeclass specialiser doesn't assume any two evidence terms
-of the same type are equal. See Note [withDict] in GHC.Tc.Instance.Class,
-and see test case T21575b for an example.
+'nospec' is used:
+
+* In the implementation of 'withDict': we insert 'nospec' so that the
+ typeclass specialiser doesn't assume any two evidence terms of the
+ same type are equal. See Note [withDict] in GHC.Tc.Instance.Class,
+ and see test case T21575b for an example.
+
+* To defeat the specialiser when we have incoherent instances.
+ See Note [Coherence and specialisation: overview] in GHC.Core.InstEnv.
Note [The oneShot function]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/GHC/Wasm/ControlFlow/FromCmm.hs
=====================================
@@ -19,12 +19,13 @@ import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dominators
import GHC.Cmm.Dataflow.Graph
import GHC.Cmm.Dataflow.Label
+import GHC.Cmm.Reducibility
import GHC.Cmm.Switch
import GHC.CmmToAsm.Wasm.Types
import GHC.Platform
-
+import GHC.Types.Unique.Supply
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Utils.Outputable ( Outputable, text, (<+>), ppr
@@ -140,15 +141,19 @@ emptyPost _ = False
structuredControl :: forall expr stmt m .
Applicative m
=> Platform -- ^ needed for offset calculation
+ -> UniqSupply
-> (Label -> CmmExpr -> m expr) -- ^ translator for expressions
-> (Label -> CmmActions -> m stmt) -- ^ translator for straight-line code
-> CmmGraph -- ^ CFG to be translated
-> m (WasmControl stmt expr '[] '[ 'I32])
-structuredControl platform txExpr txBlock g =
+structuredControl platform us txExpr txBlock g' =
doTree returns dominatorTree emptyContext
where
+ g :: CmmGraph
+ g = gwd_graph gwd
+
gwd :: GraphWithDominators CmmNode
- gwd = graphWithDominators g
+ gwd = initUs_ us $ asReducible $ graphWithDominators g'
dominatorTree :: Tree.Tree CmmBlock-- Dominator tree in which children are sorted
-- with highest reverse-postorder number first
=====================================
hadrian/src/Oracles/TestSettings.hs
=====================================
@@ -25,8 +25,9 @@ data TestSetting = TestHostOS
| TestTARGETPLATFORM
| TestTargetOS_CPP
| TestTargetARCH_CPP
+ | TestRTSWay
| TestGhcStage
- | TestGhcDebugged
+ | TestGhcDebugAssertions
| TestGhcWithNativeCodeGen
| TestGhcWithInterpreter
| TestGhcWithRtsLinker
@@ -56,8 +57,9 @@ testSetting key = do
TestTARGETPLATFORM -> "TARGETPLATFORM"
TestTargetOS_CPP -> "TargetOS_CPP"
TestTargetARCH_CPP -> "TargetARCH_CPP"
+ TestRTSWay -> "RTSWay"
TestGhcStage -> "GhcStage"
- TestGhcDebugged -> "GhcDebugged"
+ TestGhcDebugAssertions -> "GhcDebugAssertions"
TestGhcWithNativeCodeGen -> "GhcWithNativeCodeGen"
TestGhcWithInterpreter -> "GhcWithInterpreter"
TestGhcWithRtsLinker -> "GhcWithRtsLinker"
=====================================
hadrian/src/Settings/Builders/RunTest.hs
=====================================
@@ -69,6 +69,9 @@ data TestCompilerArgs = TestCompilerArgs{
, unregisterised :: Bool
, tables_next_to_code :: Bool
, targetWithSMP :: Bool -- does the target support SMP
+ , debugged :: Bool
+ -- ^ Whether the compiler has the debug RTS,
+ -- corresponding to the -debug option.
, debugAssertions :: Bool
-- ^ Whether the compiler has debug assertions enabled,
-- corresponding to the -DDEBUG option.
@@ -104,6 +107,7 @@ inTreeCompilerArgs stg = do
let ghcStage = succStage stg
debugAssertions <- ghcDebugAssertions <$> flavour <*> pure ghcStage
+ debugged <- ghcDebugged <$> flavour <*> pure ghcStage
profiled <- ghcProfiled <$> flavour <*> pure ghcStage
os <- setting HostOs
@@ -149,12 +153,14 @@ outOfTreeCompilerArgs = do
unregisterised <- getBooleanSetting TestGhcUnregisterised
tables_next_to_code <- getBooleanSetting TestGhcTablesNextToCode
targetWithSMP <- targetSupportsSMP
- debugAssertions <- getBooleanSetting TestGhcDebugged
+ debugAssertions <- getBooleanSetting TestGhcDebugAssertions
os <- getTestSetting TestHostOS
arch <- getTestSetting TestTargetARCH_CPP
platform <- getTestSetting TestTARGETPLATFORM
wordsize <- getTestSetting TestWORDSIZE
+ rtsWay <- getTestSetting TestRTSWay
+ let debugged = "debug" `isInfixOf` rtsWay
llc_cmd <- getTestSetting TestLLC
have_llvm <- liftIO (isJust <$> findExecutable llc_cmd)
@@ -243,6 +249,7 @@ runTestBuilderArgs = builder Testsuite ? do
, arg "-e", arg $ "config.accept_os=" ++ show acceptOS
, arg "-e", arg $ "config.exeext=" ++ quote (if null exe then "" else "."<>exe)
, arg "-e", arg $ "config.compiler_debugged=" ++ show debugAssertions
+ , arg "-e", arg $ "config.debug_rts=" ++ show debugged
-- MP: TODO, we do not need both, they get aliased to the same thing.
, arg "-e", arg $ asBool "ghc_with_native_codegen=" withNativeCodeGen
=====================================
libraries/base/base.cabal
=====================================
@@ -5,8 +5,8 @@ version: 4.18.0.0
license: BSD-3-Clause
license-file: LICENSE
-maintainer: libraries at haskell.org
-bug-reports: https://gitlab.haskell.org/ghc/ghc/issues/new
+maintainer: Core Libraries Committee <core-libraries-committee at haskell.org>
+bug-reports: https://github.com/haskell/core-libraries-committee/issues
synopsis: Basic libraries
category: Prelude
build-type: Configure
=====================================
rts/Printer.c
=====================================
@@ -297,6 +297,45 @@ printClosure( const StgClosure *obj )
break;
}
+ case ATOMICALLY_FRAME:
+ {
+ StgAtomicallyFrame* u = (StgAtomicallyFrame*)obj;
+ debugBelch("ATOMICALLY_FRAME(");
+ printPtr((StgPtr)GET_INFO((StgClosure *)u));
+ debugBelch(",");
+ printPtr((StgPtr)u->code);
+ debugBelch(",");
+ printPtr((StgPtr)u->result);
+ debugBelch(")\n");
+ break;
+ }
+
+ case CATCH_RETRY_FRAME:
+ {
+ StgCatchRetryFrame* u = (StgCatchRetryFrame*)obj;
+ debugBelch("CATCH_RETRY_FRAME(");
+ printPtr((StgPtr)GET_INFO((StgClosure *)u));
+ debugBelch(",");
+ printPtr((StgPtr)u->first_code);
+ debugBelch(",");
+ printPtr((StgPtr)u->alt_code);
+ debugBelch(")\n");
+ break;
+ }
+
+ case CATCH_STM_FRAME:
+ {
+ StgCatchSTMFrame* u = (StgCatchSTMFrame*)obj;
+ debugBelch("CATCH_STM_FRAME(");
+ printPtr((StgPtr)GET_INFO((StgClosure *)u));
+ debugBelch(",");
+ printPtr((StgPtr)u->code);
+ debugBelch(",");
+ printPtr((StgPtr)u->handler);
+ debugBelch(")\n");
+ break;
+ }
+
case ARR_WORDS:
{
StgWord i;
@@ -319,6 +358,10 @@ printClosure( const StgClosure *obj )
debugBelch("MUT_ARR_PTRS_FROZEN_CLEAN(size=%" FMT_Word ")\n", (W_)((StgMutArrPtrs *)obj)->ptrs);
break;
+ case MUT_ARR_PTRS_FROZEN_DIRTY:
+ debugBelch("MUT_ARR_PTRS_FROZEN_DIRTY(size=%" FMT_Word ")\n", (W_)((StgMutArrPtrs *)obj)->ptrs);
+ break;
+
case SMALL_MUT_ARR_PTRS_CLEAN:
debugBelch("SMALL_MUT_ARR_PTRS_CLEAN(size=%" FMT_Word ")\n",
(W_)((StgSmallMutArrPtrs *)obj)->ptrs);
@@ -334,6 +377,11 @@ printClosure( const StgClosure *obj )
(W_)((StgSmallMutArrPtrs *)obj)->ptrs);
break;
+ case SMALL_MUT_ARR_PTRS_FROZEN_DIRTY:
+ debugBelch("SMALL_MUT_ARR_PTRS_FROZEN_DIRTY(size=%" FMT_Word ")\n",
+ (W_)((StgSmallMutArrPtrs *)obj)->ptrs);
+ break;
+
case MVAR_CLEAN:
case MVAR_DIRTY:
{
@@ -533,6 +581,9 @@ printStackChunk( StgPtr sp, StgPtr spBottom )
case CATCH_FRAME:
case UNDERFLOW_FRAME:
case STOP_FRAME:
+ case ATOMICALLY_FRAME:
+ case CATCH_RETRY_FRAME:
+ case CATCH_STM_FRAME:
printClosure((StgClosure*)sp);
continue;
=====================================
testsuite/driver/testglobals.py
=====================================
@@ -64,6 +64,9 @@ class TestConfig:
# Was the compiler compiled with DEBUG?
self.compiler_debugged = False
+ # Was the compiler compiled with -debug?
+ self.debug_rts = False
+
# Was the compiler compiled with LLVM?
self.ghc_built_by_llvm = False
=====================================
testsuite/driver/testlib.py
=====================================
@@ -681,6 +681,9 @@ def compiler_profiled( ) -> bool:
def compiler_debugged( ) -> bool:
return config.compiler_debugged
+def debug_rts( ) -> bool:
+ return config.debug_rts
+
def have_gdb( ) -> bool:
return config.have_gdb
=====================================
testsuite/ghc-config/ghc-config.hs
=====================================
@@ -13,12 +13,13 @@ main = do
getGhcFieldOrFail fields "TARGETPLATFORM" "Target platform"
getGhcFieldOrFail fields "TargetOS_CPP" "Target OS"
getGhcFieldOrFail fields "TargetARCH_CPP" "Target architecture"
+ getGhcFieldOrFail fields "RTSWay" "RTS way"
info <- readProcess ghc ["--info"] ""
let fields = read info :: [(String,String)]
getGhcFieldOrFail fields "GhcStage" "Stage"
- getGhcFieldOrFail fields "GhcDebugged" "Debug on"
+ getGhcFieldOrFail fields "GhcDebugAssertions" "Debug on"
getGhcFieldOrFail fields "GhcWithNativeCodeGen" "Have native code generator"
getGhcFieldOrFail fields "GhcWithInterpreter" "Have interpreter"
getGhcFieldOrFail fields "GhcWithRtsLinker" "target has RTS linker"
=====================================
testsuite/mk/test.mk
=====================================
@@ -78,7 +78,7 @@ endif
RUNTEST_OPTS += -e "ghc_compiler_always_flags='$(TEST_HC_OPTS)'"
-ifeq "$(GhcDebugged)" "YES"
+ifeq "$(GhcDebugAssertions)" "YES"
RUNTEST_OPTS += -e "config.compiler_debugged=True"
else
RUNTEST_OPTS += -e "config.compiler_debugged=False"
=====================================
testsuite/tests/rts/Makefile
=====================================
@@ -147,3 +147,13 @@ EventlogOutput_IPE:
"$(TEST_HC)" -debug -finfo-table-map -v0 EventlogOutput.hs
./EventlogOutput +RTS -va 2> EventlogOutput_IPE.stderr.log
grep "IPE:" EventlogOutput_IPE.stderr.log
+
+.PHONY: T23142
+T23142:
+ # Test that the -Di output contains different frames
+ "$(TEST_HC)" --run -ignore-dot-ghci T23142.hs +RTS -Di -RTS 2> T23142.log
+ grep -m1 -c "ATOMICALLY_FRAME" T23142.log
+ grep -m1 -c "CATCH_RETRY_FRAME" T23142.log
+ grep -m1 -c "CATCH_STM_FRAME" T23142.log
+ grep -m1 -c "MUT_ARR_PTRS_FROZEN_DIRTY" T23142.log
+ grep -m1 -c "SMALL_MUT_ARR_PTRS_FROZEN_DIRTY" T23142.log
=====================================
testsuite/tests/rts/T23142.hs
=====================================
@@ -0,0 +1,18 @@
+{-# LANGUAGE UnboxedTuples, MagicHash #-}
+module T23142 where
+
+import GHC.IO
+import GHC.Exts
+
+main :: IO ()
+main = IO (\s -> case newArray# 10# (2 :: Int) s of
+ (# s', a #) -> case unsafeFreezeArray# a s' of
+ (# s'', _ #) -> (# s'', () #))
+ >>
+ IO (\s -> case newSmallArray# 10# (2 :: Int) s of
+ (# s', a #) -> case unsafeFreezeSmallArray# a s' of
+ (# s'', _ #) -> (# s'', () #))
+ >>
+ IO (atomically# (\s -> catchSTM# (\s -> (# s, () #)) (\_ s -> (# s, () #)) s))
+ >>
+ IO (atomically# (\s -> catchRetry# (\s -> (# s, () #)) (\s -> (# s, () #)) s))
=====================================
testsuite/tests/rts/T23142.stdout
=====================================
@@ -0,0 +1,5 @@
+1
+1
+1
+1
+1
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -575,3 +575,5 @@ test('T22795b', [only_ways(['normal']), js_skip], compile_and_run, ['-single-thr
test('T22795c', [only_ways(['normal']), js_skip], compile_and_run, ['-threaded -single-threaded'])
test('T17574', [js_skip], compile_and_run, ['-with-rtsopts -T'])
+
+test('T23142', [unless(debug_rts(), skip), req_interp], makefile_test, ['T23142'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3cf6809efb65a286349c4b453bc38ccaed03c90c...e6ab90e6a4dd8902d8f785f5e6a421f1d95cb844
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3cf6809efb65a286349c4b453bc38ccaed03c90c...e6ab90e6a4dd8902d8f785f5e6a421f1d95cb844
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/20230411/e6806012/attachment-0001.html>
More information about the ghc-commits
mailing list