diff --git a/compiler/GHC/Core/Opt/Simplify/Iteration.hs b/compiler/GHC/Core/Opt/Simplify/Iteration.hs index 6d44fa869249a0b4fa075eb09d8d6d24a741177a..7b876900fea59fd0920319d5cac5407ef9760fdb 100644 --- a/compiler/GHC/Core/Opt/Simplify/Iteration.hs +++ b/compiler/GHC/Core/Opt/Simplify/Iteration.hs @@ -64,7 +64,7 @@ import GHC.Builtin.PrimOps ( PrimOp (SeqOp) ) import GHC.Builtin.Types.Prim( realWorldStatePrimTy ) import GHC.Builtin.Names( runRWKey ) -import GHC.Data.Maybe ( isNothing, orElse ) +import GHC.Data.Maybe ( isNothing, orElse, mapMaybe ) import GHC.Data.FastString import GHC.Unit.Module ( moduleName ) import GHC.Utils.Outputable @@ -1436,7 +1436,7 @@ simplTick env tickish expr cont simplTickish env tickish | Breakpoint ext n ids modl <- tickish - = Breakpoint ext n (map (getDoneId . substId env) ids) modl + = Breakpoint ext n (mapMaybe (getDoneId . substId env) ids) modl | otherwise = tickish -- Push type application and coercion inside a tick @@ -1447,8 +1447,9 @@ simplTick env tickish expr cont where (inc,outc) = splitCont c splitCont other = (mkBoringStop (contHoleType other), other) - getDoneId (DoneId id) = id - getDoneId (DoneEx e _) = getIdFromTrivialExpr e -- Note [substTickish] in GHC.Core.Subst + getDoneId (DoneId id) = Just id + getDoneId (DoneEx (Var id) _) = Just id + getDoneId (DoneEx e _) = getIdFromTrivialExpr_maybe e -- Note [substTickish] in GHC.Core.Subst getDoneId other = pprPanic "getDoneId" (ppr other) -- Note [case-of-scc-of-case] diff --git a/compiler/GHC/Core/Subst.hs b/compiler/GHC/Core/Subst.hs index 632f7b5149453372c70dfc0996e20805e7870486..75d341f77226bbdbaff353a2c7c59b9abb015095 100644 --- a/compiler/GHC/Core/Subst.hs +++ b/compiler/GHC/Core/Subst.hs @@ -592,9 +592,9 @@ substDVarSet subst@(Subst _ _ tv_env cv_env) fvs ------------------ substTickish :: Subst -> CoreTickish -> CoreTickish substTickish subst (Breakpoint ext n ids modl) - = Breakpoint ext n (map do_one ids) modl + = Breakpoint ext n (mapMaybe do_one ids) modl where - do_one = getIdFromTrivialExpr . lookupIdSubst subst + do_one = getIdFromTrivialExpr_maybe . lookupIdSubst subst substTickish _subst other = other {- Note [Substitute lazily] @@ -649,6 +649,13 @@ Second, we have to ensure that we never try to substitute a literal for an Id in a breakpoint. We ensure this by never storing an Id with an unlifted type in a Breakpoint - see GHC.HsToCore.Ticks.mkTickish. Breakpoints can't handle free variables with unlifted types anyway. + +These measures are only reliable with unoptimized code. +Since we can now enable optimizations for GHCi with +@-fno-unoptimized-core-for-interpreter -O@, nontrivial expressions can be +substituted, e.g. by specializations. +Therefore we resort to discarding free variables from breakpoints when this +situation occurs. -} {- diff --git a/docs/users_guide/debugging.rst b/docs/users_guide/debugging.rst index 9409e27fe2349129983c8ff106c7a741daf9adfe..097f3dac410e2c712301ac21f54ca6bff87d0d11 100644 --- a/docs/users_guide/debugging.rst +++ b/docs/users_guide/debugging.rst @@ -1203,3 +1203,9 @@ Other This option can be used to override this check, e.g. ``ghci -O2 -fno-unoptimized-core-for-interpreter``. It is not recommended for normal use and can cause a compiler panic. + + Note that this has an effect on the debugger interface: With optimizations + in play, free variables in breakpoints may now be substituted with complex + expressions. + Those cannot be stored in breakpoints, so any free variable that refers to + optimized code will not be inspectable when this flag is enabled. diff --git a/libraries/base/tests/IO/all.T b/libraries/base/tests/IO/all.T index 72ef0bcbf647fc06cc1ce871ef98aa94176b30b6..c86bb3ee393377eb9bcca26a281660489373bf3c 100644 --- a/libraries/base/tests/IO/all.T +++ b/libraries/base/tests/IO/all.T @@ -96,7 +96,6 @@ test('hGetBuf001', [ when(fast(), skip) , expect_fail_if_windows , js_broken(22374) - , expect_broken_for(23272, ['ghci-opt']) , req_process ], compile_and_run, ['-package unix']) diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T index 147422e648cfc4d52bb7ab9e20b89fcde36733e5..261929be7e19626208be7e96f0100b45afcf91e7 100644 --- a/libraries/base/tests/all.T +++ b/libraries/base/tests/all.T @@ -49,7 +49,7 @@ test('isValidNatural', normal, compile_and_run, ['']) # need to add -K64m to the compiler opts, so that GHCi gets it too test('ioref001', - [when(fast(), skip),extra_run_opts('+RTS -K64m -RTS'), expect_broken_for(23272, ['ghci-opt'])], + [when(fast(), skip),extra_run_opts('+RTS -K64m -RTS')], compile_and_run, ['+RTS -K64m -RTS']) @@ -250,7 +250,7 @@ test('T11334a', normal, compile_and_run, ['']) test('T11555', normal, compile_and_run, ['']) test('T12494', normal, compile_and_run, ['']) test('T12852', [when(opsys('mingw32'), skip), js_broken(22374), req_process], compile_and_run, ['']) -test('lazySTexamples', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['']) +test('lazySTexamples', normal, compile_and_run, ['']) test('T11760', [req_ghc_smp, req_target_smp, only_ways(['threaded1', 'threaded2', 'nonmoving_thr'])], @@ -304,7 +304,7 @@ test('T19719', normal, compile_and_run, ['']) test('T20107', extra_run_opts('+RTS -M50M'), compile_and_run, ['-package bytestring']) test('T22816', normal, compile_and_run, ['']) test('trace', normal, compile_and_run, ['']) -test('listThreads', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['']) +test('listThreads', normal, compile_and_run, ['']) test('listThreads1', omit_ghci, compile_and_run, ['']) test('inits1tails1', normal, compile_and_run, ['']) test('CLC149', normal, compile, ['']) diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T index d9a760cfe5247d3c467634a1bd10ab75d015f6ed..87f6d5744205586367f7a81e0a62593719a926d6 100644 --- a/testsuite/tests/codeGen/should_run/all.T +++ b/testsuite/tests/codeGen/should_run/all.T @@ -69,7 +69,7 @@ test('cgrun060', test('cgrun061', normal, compile_and_run, ['']) test('cgrun062', normal, compile_and_run, ['']) test('cgrun063', normal, compile_and_run, ['']) -test('cgrun064', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['']) +test('cgrun064', normal, compile_and_run, ['']) test('cgrun065', normal, compile_and_run, ['']) test('cgrun066', normal, compile_and_run, ['']) test('cgrun067', [extra_files(['Cgrun067A.hs'])], compile_and_run, ['']) @@ -140,9 +140,9 @@ test('CgStaticPointersNoFullLazyness', [when(doing_ghci(), extra_hc_opts('-fobje test('StaticArraySize', [when(doing_ghci(), extra_hc_opts('-fobject-code'))], compile_and_run, ['-O2']) test('StaticByteArraySize', normal, compile_and_run, ['-O2']) -test('CopySmallArray', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['']) +test('CopySmallArray', normal, compile_and_run, ['']) test('SizeOfSmallArray', normal, compile_and_run, ['']) -test('NewSmallArray', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['']) +test('NewSmallArray', normal, compile_and_run, ['']) test('T9001', normal, compile_and_run, ['']) test('T9013', normal, compile_and_run, ['']) @@ -223,5 +223,5 @@ test('T20640a', normal, compile_and_run, ['']) test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) -test('T22798', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['-fregs-graph']) +test('T22798', normal, compile_and_run, ['-fregs-graph']) test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T index 1ff8c25c1cdfb6c401add8e2c1da8a661e9caaf0..b1c9d42daf91c9f3b8c4320ddb0a98c69edfd619 100644 --- a/testsuite/tests/concurrent/should_run/all.T +++ b/testsuite/tests/concurrent/should_run/all.T @@ -81,7 +81,7 @@ test('T5611a', fragile(12751), compile_and_run, ['']) test('T5238', normal, compile_and_run, ['']) test('T5866', exit_code(1), compile_and_run, ['']) -test('readMVar1', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['']) +test('readMVar1', normal, compile_and_run, ['']) test('readMVar2', normal, compile_and_run, ['']) test('readMVar3', normal, compile_and_run, ['']) test('tryReadMVar1', normal, compile_and_run, ['']) @@ -149,7 +149,7 @@ test('conc016', [omit_ways(concurrent_ways) # see comment in conc016.hs test('conc017', normal, compile_and_run, ['']) test('conc017a', normal, compile_and_run, ['']) test('conc018', normal, compile_and_run, ['']) -test('conc019', [extra_run_opts('+RTS -K16m -RTS'), expect_broken_for(23272, ['ghci-opt'])], compile_and_run, ['']) +test('conc019', [extra_run_opts('+RTS -K16m -RTS')], compile_and_run, ['']) test('conc020', normal, compile_and_run, ['']) test('conc021', [ omit_ghci, exit_code(1) diff --git a/testsuite/tests/ghc-api/target-contents/all.T b/testsuite/tests/ghc-api/target-contents/all.T index 488a343895070b001723e2f9d01b779696649fa2..3deaceaef67678a7e30204ef2862291ff005ff40 100644 --- a/testsuite/tests/ghc-api/target-contents/all.T +++ b/testsuite/tests/ghc-api/target-contents/all.T @@ -1,7 +1,6 @@ test('TargetContents', [ extra_run_opts('"' + config.libdir + '"') , js_broken(22362) - , expect_broken_for(23272, ['ghci-opt']) , req_process ] , compile_and_run, diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index c2188732c363c7c2197185cb7e79388995fd21e2..62d18f42ff9b60aaf00ae9b40f70f876337c0586 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -277,7 +277,7 @@ test('T13420', normal, ghci_script, ['T13420.script']) test('T13466', normal, ghci_script, ['T13466.script']) test('GhciCurDir', normal, ghci_script, ['GhciCurDir.script']) test('T13591', expect_broken(13591), ghci_script, ['T13591.script']) -test('T13699', expect_broken_for(23272, ['ghci-opt']), ghci_script, ['T13699.script']) +test('T13699', normal, ghci_script, ['T13699.script']) test('T13988', normal, ghci_script, ['T13988.script']) test('T13997', [extra_run_opts('-fobject-code')], ghci_script, ['T13997.script']) test('T13407', normal, ghci_script, ['T13407.script']) @@ -319,7 +319,7 @@ test('T16876', normal, ghci_script, ['T16876.script']) test('T17345', normal, ghci_script, ['T17345.script']) test('T17384', normal, ghci_script, ['T17384.script']) test('T17403', normal, ghci_script, ['T17403.script']) -test('T17431', expect_broken_for(23272, ['ghci-opt']), ghci_script, ['T17431.script']) +test('T17431', normal, ghci_script, ['T17431.script']) test('T17500', [extra_run_opts('-ddump-to-file -ddump-bcos')], ghci_script, ['T17500.script']) test('T17549', normal, ghci_script, ['T17549.script']) test('T17669', [extra_run_opts('-fexternal-interpreter -fobject-code'), diff --git a/testsuite/tests/numeric/should_run/all.T b/testsuite/tests/numeric/should_run/all.T index 927d1a890ab771eb1c054f5399a8597d0aed205a..26bb1fe2c62a84f361248942b3ce84b43100528a 100644 --- a/testsuite/tests/numeric/should_run/all.T +++ b/testsuite/tests/numeric/should_run/all.T @@ -57,7 +57,7 @@ test('T7014', js_skip, makefile_test, []) test('T7233', normal, compile_and_run, ['']) test('NumDecimals', normal, compile_and_run, ['']) -test('T8726', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['']) +test('T8726', normal, compile_and_run, ['']) test('CarryOverflow', normal, compile_and_run, ['']) test('T9407', normal, compile_and_run, ['']) test('T9810', normal, compile_and_run, ['']) diff --git a/testsuite/tests/primops/should_run/all.T b/testsuite/tests/primops/should_run/all.T index 7c121d25842058ffa1fd12c971f6960c1816799c..8e4afa0b538c7f562a8dfe98b811074a02c19bb8 100644 --- a/testsuite/tests/primops/should_run/all.T +++ b/testsuite/tests/primops/should_run/all.T @@ -60,7 +60,6 @@ test('UnliftedWeakPtr', normal, compile_and_run, ['']) test('FMA_Primops' , [ when(have_cpu_feature('fma'), extra_hc_opts('-mfma')) , js_skip # JS backend doesn't have an FMA implementation - , expect_broken_for(23272, ['ghci-opt']) ] , compile_and_run, ['']) test('FMA_ConstantFold' diff --git a/testsuite/tests/programs/jtod_circint/test.T b/testsuite/tests/programs/jtod_circint/test.T index 835c3f7b35ff2e8867a845777468e87da241a830..0d873665ba35a31fd4f1132e5a5ee87f24e5c64f 100644 --- a/testsuite/tests/programs/jtod_circint/test.T +++ b/testsuite/tests/programs/jtod_circint/test.T @@ -1,4 +1,4 @@ -test('jtod_circint', [extra_files(['Bit.hs', 'LogFun.hs', 'Main.hs', 'Signal.hs']), expect_broken_for(23272, ['ghci-opt']), +test('jtod_circint', [extra_files(['Bit.hs', 'LogFun.hs', 'Main.hs', 'Signal.hs']), when(fast(), skip)], multimod_compile_and_run, ['Main', '']) diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index c1f763a564c047ee27b7e853164c4fffd09b5ec4..06414a6615e40766c747a4f3eefeb7dae2b8a61c 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -143,7 +143,6 @@ test('stack003', [ omit_ghci, # parameter 50000 is not passed # Test that +RTS -K0 (e.g. no stack limit) parses correctly test('stack004', [ extra_run_opts('+RTS -K0 -RTS') , js_broken(22374) - , expect_broken_for(23272, ['ghci-opt']) , expect_broken_for(14913, ['ghci']) ], compile_and_run, ['']) @@ -265,7 +264,6 @@ test('T7037', req_c, makefile_test, ['T7037']) test('T7087', exit_code(1), compile_and_run, ['']) test('T7160', [ # finalization order is different in the nonmoving omit_ways(['nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc', 'nonmoving_thr_sanity']) - , expect_broken_for(23272, ['ghci-opt']) , js_broken(22261) ], compile_and_run, ['']) @@ -285,7 +283,7 @@ test('T7227', [extra_run_opts('+RTS -tT7227.stat --machine-readable -RTS')], test('T7636', [ exit_code(1), extra_run_opts('100000') ], compile_and_run, [''] ) -test('stablename001', [expect_fail_for(['hpc']), expect_broken_for(23272, ['ghci-opt'])], compile_and_run, ['']) +test('stablename001', [expect_fail_for(['hpc'])], compile_and_run, ['']) # hpc should fail this, because it tags every variable occurrence with # a different tick. It's probably a bug if it works, hence expect_fail. diff --git a/testsuite/tests/simplCore/T9646/test.T b/testsuite/tests/simplCore/T9646/test.T index 583682120bda73c8c9ab1de8b0322e2cd2d749b6..fc20cb89499398a7cd4a6376714de80d4880aeac 100644 --- a/testsuite/tests/simplCore/T9646/test.T +++ b/testsuite/tests/simplCore/T9646/test.T @@ -1,4 +1,4 @@ test('T9646', [extra_files(['Main.hs', 'Natural.hs', 'StrictPrim.hs', 'Type.hs']), - when(fast(), skip), expect_broken_for(23272, ['ghci-opt'])], + when(fast(), skip)], multimod_compile_and_run, ['Main -ddump-simpl -ddump-to-file', '']) diff --git a/testsuite/tests/simplCore/should_compile/T23272.hs b/testsuite/tests/simplCore/should_compile/T23272.hs new file mode 100644 index 0000000000000000000000000000000000000000..88f1a7159eb150e5fe35688fd9bc2254bd4a1beb --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T23272.hs @@ -0,0 +1,9 @@ +module T23272 where + +class C a where +instance C () where + +bug :: (forall a. C a => a -> a) -> () +bug g = f () + where + f x = seq (g x) undefined diff --git a/testsuite/tests/simplCore/should_compile/T23272.script b/testsuite/tests/simplCore/should_compile/T23272.script new file mode 100644 index 0000000000000000000000000000000000000000..31f969173c32bca072b5b61bf054e5f212f35070 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T23272.script @@ -0,0 +1 @@ +:load T23272 diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index 26542e89f510f21a0c609faf7ab91794b0398b8a..2ecf4c368b5d54513649209d37cdd3dde09b054b 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -489,3 +489,4 @@ test('T23491b', [extra_files(['T23491.hs']), grep_errmsg(r'Float inwards')], mul test('T23491c', [extra_files(['T23491.hs']), grep_errmsg(r'Liberate case')], multimod_compile, ['T23491', '-fliberate-case -ddump-liberate-case']) test('T23491d', [extra_files(['T23491.hs']), grep_errmsg(r'Static argument')], multimod_compile, ['T23491', '-fstatic-argument-transformation -ddump-static-argument-transformation']) test('T23074', normal, compile, ['-O -ddump-rules']) +test('T23272', [only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -O')], ghci_script, ['T23272.script']) diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 88e674dcc0f8e5cd625af2cd7f52bdabed49dfb2..b82cdc1c96e603954e130f6a39fb44af2c5c148b 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -327,8 +327,8 @@ test('T10596', normal, compile, ['-v0']) test('T10598_TH', normal, compile, ['-v0 -dsuppress-uniques -ddump-splices']) test('T10620', normal, compile_and_run, ['-v0']) test('T10638', normal, compile_fail, ['-v0']) -test('T10697_decided_1', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['-v0']) -test('T10697_decided_2', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['-XStrictData -v0']) +test('T10697_decided_1', normal, compile_and_run, ['-v0']) +test('T10697_decided_2', normal, compile_and_run, ['-XStrictData -v0']) test('T10697_decided_3', normal, compile_and_run, ['-XStrictData -funbox-strict-fields -O2 -v0']) test('T10697_source', [], multimod_compile_and_run, ['T10697_source', '-w ' + config.ghc_th_way_flags]) diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 577c81401a54b1fe378fb84ceda6d7692bc9e6cb..13bb8cbd501c445e0de3263b4416e0749e9c3e75 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -693,7 +693,7 @@ test('UnlifNewUnify', normal, compile, ['']) test('UnliftedNewtypesLPFamily', normal, compile, ['']) test('UnliftedNewtypesDifficultUnification', normal, compile, ['']) test('LevPolyResult', normal, compile, ['']) -test('T16832', expect_broken_for(23272, ['ghci-opt']), ghci_script, ['T16832.script']) +test('T16832', normal, ghci_script, ['T16832.script']) test('T15772', normal, compile, ['']) test('T16995', normal, compile, ['']) test('T17007', normal, compile, ['']) diff --git a/testsuite/tests/typecheck/should_run/all.T b/testsuite/tests/typecheck/should_run/all.T index 44265796e53cd0edce82a4e6445db2430d69879e..b3272d19953daaf2504b3b8c7625a5a4cf36a242 100755 --- a/testsuite/tests/typecheck/should_run/all.T +++ b/testsuite/tests/typecheck/should_run/all.T @@ -76,10 +76,10 @@ test('IPRun', normal, compile_and_run, ['']) test('IPLocation', normal, compile_and_run, ['']) test('T10845', normal, compile_and_run, ['']) test('T10846', normal, compile_and_run, ['']) -test('T16646', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['']) +test('T16646', normal, compile_and_run, ['']) # Support files for T1735 are in directory T1735_Help/ -test('T1735', expect_broken_for(23272, ['ghci-opt']), multimod_compile_and_run, ['T1735','']) +test('T1735', normal, multimod_compile_and_run, ['T1735','']) # The following two tests no longer compile # See Note [Inferring principal types] in Ghc.Tc.Solver