[Git][ghc/ghc][wip/slowtest] 20 commits: Fix #16282.
Ben Gamari
gitlab at gitlab.haskell.org
Sun Apr 7 20:48:06 UTC 2019
Ben Gamari pushed to branch wip/slowtest at Glasgow Haskell Compiler / GHC
Commits:
3a38ea44 by Eric Crockett at 2019-04-07T19:21:59Z
Fix #16282.
Previously, -W(all-)missed-specs was created with 'NoReason',
so no information about the flag was printed along with the warning.
Now, -Wall-missed-specs is listed as the Reason if it was set,
otherwise -Wmissed-specs is listed as the reason.
- - - - -
0444686f by Ben Gamari at 2019-04-07T20:47:56Z
gitlab-ci: Test using slowtest in deb9-debug job
- - - - -
5c6bc7e6 by Ben Gamari at 2019-04-07T20:47:56Z
testsuite: Mark hWaitForInput-accurate-stdin as broken in threaded ways
As noted in #16535.
- - - - -
659fda69 by Ömer Sinan Ağacan at 2019-04-07T20:47:56Z
Skip test ArithInt16 and ArithWord16 in GHCi way
These tests use unboxed tuples, which GHCi doesn't support
- - - - -
5848c290 by Ben Gamari at 2019-04-07T20:47:57Z
testsuite: Make closureSize less sensitive to optimisation
- - - - -
d94924fa by Ben Gamari at 2019-04-07T20:47:57Z
process: Bump submodule
* Skip process005 in ghci way
* Mark process002 as fragile in threaded2
- - - - -
80d08448 by Ben Gamari at 2019-04-07T20:47:57Z
testsuite: Mark T13167 as fragile in threaded2
As noted in #16536.
- - - - -
2954a91e by Ben Gamari at 2019-04-07T20:47:57Z
testsuite: Mark T13910 as broken in optasm
Due to #16537.
- - - - -
ca847286 by Ben Gamari at 2019-04-07T20:47:57Z
testsuite: Mark T14272 as broken in optasm
- - - - -
a36acf15 by Ben Gamari at 2019-04-07T20:47:57Z
testsuite: Mark T14761c as broken in hpc and optasm ways
As noted in #16540.
- - - - -
2b546d80 by Ben Gamari at 2019-04-07T20:47:57Z
testsuite: Mark T16180 as broken in ghci and ext-interp ways
As noted in #16541.
- - - - -
4eac3fd9 by Ben Gamari at 2019-04-07T20:47:57Z
testsuite: Omit tcrun022 in hpc way
As noted in #16542, the expected rule doesn't fire. However, this
doesn't seem terribly surpring given the circumstances.
- - - - -
a52b8edf by Ben Gamari at 2019-04-07T20:47:57Z
testsuite: Mark Overflow as broken in hpc way
As noted in #16543.
- - - - -
b18ceb7e by Ben Gamari at 2019-04-07T20:47:57Z
testsuite: Mark closure_size as broken in threaded2, optasm, dyn ways
As noted in #16531.
- - - - -
c9a1412c by Ben Gamari at 2019-04-07T20:47:57Z
testsuite: Mark T2783 as fragile in threaded1
It was previously marked as broken but it passes non-deterministically.
See #2783.
- - - - -
109fd2b3 by Ben Gamari at 2019-04-07T20:47:57Z
testsuite: Skip T7919 in ghci way
It times out pretty reliably. It's not clear that much is gained by
running this test in the ghci way anyways.
- - - - -
6c7dc902 by Ben Gamari at 2019-04-07T20:47:57Z
testsuite: Fix fragile_for test modifier
- - - - -
e3ed757a by Ben Gamari at 2019-04-07T20:47:57Z
users-guide: Add pretty to package list
- - - - -
9a685b82 by Ben Gamari at 2019-04-07T20:47:57Z
Bump unix submodule
Marks posix002 as fragile in threaded2 way due to #16550.
- - - - -
d7106e24 by Ben Gamari at 2019-04-07T20:47:57Z
testsuite: Fix omit_ways usage
omit_ways expects a list but this was broken in several cases.
- - - - -
25 changed files:
- .gitlab-ci.yml
- compiler/simplCore/CoreMonad.hs
- compiler/specialise/Specialise.hs
- docs/users_guide/8.8.1-notes.rst
- libraries/base/tests/all.T
- libraries/ghc-heap/tests/all.T
- libraries/ghc-heap/tests/closure_size.hs
- libraries/process
- libraries/unix
- testsuite/driver/testlib.py
- testsuite/tests/concurrent/should_run/all.T
- testsuite/tests/dependent/should_compile/all.T
- testsuite/tests/lib/integer/all.T
- testsuite/tests/primops/should_run/all.T
- testsuite/tests/programs/barton-mangler-bug/test.T
- testsuite/tests/rts/all.T
- testsuite/tests/simplCore/should_compile/all.T
- testsuite/tests/th/all.T
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_run/all.T
- testsuite/tests/utils/should_run/all.T
- + testsuite/tests/warnings/should_compile/T16282/T16282.hs
- + testsuite/tests/warnings/should_compile/T16282/T16282.stderr
- + testsuite/tests/warnings/should_compile/T16282/all.T
- testsuite/tests/warnings/should_compile/all.T
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -387,6 +387,7 @@ validate-x86_64-linux-deb9-debug:
stage: build
variables:
BUILD_FLAVOUR: validate
+ TEST_TYPE: slowtest
TEST_ENV: "x86_64-linux-deb9-debug"
validate-x86_64-linux-deb9-llvm:
=====================================
compiler/simplCore/CoreMonad.hs
=====================================
@@ -778,8 +778,8 @@ we aren't using annotations heavily.
************************************************************************
-}
-msg :: Severity -> SDoc -> CoreM ()
-msg sev doc
+msg :: Severity -> WarnReason -> SDoc -> CoreM ()
+msg sev reason doc
= do { dflags <- getDynFlags
; loc <- getSrcSpanM
; unqual <- getPrintUnqualified
@@ -791,7 +791,7 @@ msg sev doc
err_sty = mkErrStyle dflags unqual
user_sty = mkUserStyle dflags unqual AllTheWay
dump_sty = mkDumpStyle dflags unqual
- ; liftIO $ putLogMsg dflags NoReason sev loc sty doc }
+ ; liftIO $ putLogMsg dflags reason sev loc sty doc }
-- | Output a String message to the screen
putMsgS :: String -> CoreM ()
@@ -799,7 +799,7 @@ putMsgS = putMsg . text
-- | Output a message to the screen
putMsg :: SDoc -> CoreM ()
-putMsg = msg SevInfo
+putMsg = msg SevInfo NoReason
-- | Output an error to the screen. Does not cause the compiler to die.
errorMsgS :: String -> CoreM ()
@@ -807,9 +807,9 @@ errorMsgS = errorMsg . text
-- | Output an error to the screen. Does not cause the compiler to die.
errorMsg :: SDoc -> CoreM ()
-errorMsg = msg SevError
+errorMsg = msg SevError NoReason
-warnMsg :: SDoc -> CoreM ()
+warnMsg :: WarnReason -> SDoc -> CoreM ()
warnMsg = msg SevWarning
-- | Output a fatal error to the screen. Does not cause the compiler to die.
@@ -818,7 +818,7 @@ fatalErrorMsgS = fatalErrorMsg . text
-- | Output a fatal error to the screen. Does not cause the compiler to die.
fatalErrorMsg :: SDoc -> CoreM ()
-fatalErrorMsg = msg SevFatal
+fatalErrorMsg = msg SevFatal NoReason
-- | Output a string debugging message at verbosity level of @-v@ or higher
debugTraceMsgS :: String -> CoreM ()
@@ -826,7 +826,7 @@ debugTraceMsgS = debugTraceMsg . text
-- | Outputs a debugging message at verbosity level of @-v@ or higher
debugTraceMsg :: SDoc -> CoreM ()
-debugTraceMsg = msg SevDump
+debugTraceMsg = msg SevDump NoReason
-- | Show some labelled 'SDoc' if a particular flag is set or at a verbosity level of @-v -ddump-most@ or higher
dumpIfSet_dyn :: DumpFlag -> String -> SDoc -> CoreM ()
=====================================
compiler/specialise/Specialise.hs
=====================================
@@ -730,28 +730,35 @@ specImport dflags this_mod top_env done callers rb fn calls_for_fn
; return (rules2 ++ rules1, final_binds) }
- | warnMissingSpecs dflags callers
- = do { warnMsg (vcat [ hang (text "Could not specialise imported function" <+> quotes (ppr fn))
- 2 (vcat [ text "when specialising" <+> quotes (ppr caller)
- | caller <- callers])
- , whenPprDebug (text "calls:" <+> vcat (map (pprCallInfo fn) calls_for_fn))
- , text "Probable fix: add INLINABLE pragma on" <+> quotes (ppr fn) ])
- ; return ([], []) }
+ | otherwise = do { tryWarnMissingSpecs dflags callers fn calls_for_fn
+ ; return ([], [])}
- | otherwise
- = return ([], [])
where
unfolding = realIdUnfolding fn -- We want to see the unfolding even for loop breakers
-warnMissingSpecs :: DynFlags -> [Id] -> Bool
+-- | Returns whether or not to show a missed-spec warning.
+-- If -Wall-missed-specializations is on, show the warning.
+-- Otherwise, if -Wmissed-specializations is on, only show a warning
+-- if there is at least one imported function being specialized,
+-- and if all imported functions are marked with an inline pragma
+-- Use the most specific warning as the reason.
+tryWarnMissingSpecs :: DynFlags -> [Id] -> Id -> [CallInfo] -> CoreM ()
-- See Note [Warning about missed specialisations]
-warnMissingSpecs dflags callers
- | wopt Opt_WarnAllMissedSpecs dflags = True
- | not (wopt Opt_WarnMissedSpecs dflags) = False
- | null callers = False
- | otherwise = all has_inline_prag callers
+tryWarnMissingSpecs dflags callers fn calls_for_fn
+ | wopt Opt_WarnMissedSpecs dflags
+ && not (null callers)
+ && allCallersInlined = doWarn $ Reason Opt_WarnMissedSpecs
+ | wopt Opt_WarnAllMissedSpecs dflags = doWarn $ Reason Opt_WarnAllMissedSpecs
+ | otherwise = return ()
where
- has_inline_prag id = isAnyInlinePragma (idInlinePragma id)
+ allCallersInlined = all (isAnyInlinePragma . idInlinePragma) callers
+ doWarn reason =
+ warnMsg reason
+ (vcat [ hang (text ("Could not specialise imported function") <+> quotes (ppr fn))
+ 2 (vcat [ text "when specialising" <+> quotes (ppr caller)
+ | caller <- callers])
+ , whenPprDebug (text "calls:" <+> vcat (map (pprCallInfo fn) calls_for_fn))
+ , text "Probable fix: add INLINABLE pragma on" <+> quotes (ppr fn) ])
wantSpecImport :: DynFlags -> Unfolding -> Bool
-- See Note [Specialise imported INLINABLE things]
=====================================
docs/users_guide/8.8.1-notes.rst
=====================================
@@ -212,6 +212,7 @@ for further change information.
libraries/libiserv/libiserv.cabal: Internal compiler library
libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library
libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library
+ libraries/pretty/pretty.cabal: Dependency of ``ghc`` library
libraries/process/process.cabal: Dependency of ``ghc`` library
libraries/stm/stm.cabal: Dependency of ``haskeline`` library
libraries/template-haskell/template-haskell.cabal: Core library
=====================================
libraries/base/tests/all.T
=====================================
@@ -202,7 +202,7 @@ test('T8089',
compile_and_run, [''])
test('hWaitForInput-accurate-socket', reqlib('unix'), compile_and_run, [''])
test('T8684', expect_broken(8684), compile_and_run, [''])
-test('hWaitForInput-accurate-stdin', normal, compile_and_run, [''])
+test('hWaitForInput-accurate-stdin', [expect_broken_for(16535, ['threaded1', 'threaded2']), omit_ways(['ghci'])], compile_and_run, [''])
test('hWaitForInput-accurate-pipe', reqlib('unix'), compile_and_run, [''])
test('T9826',normal, compile_and_run,[''])
test('T9848',
@@ -233,6 +233,6 @@ test('T3474',
test('T14425', normal, compile_and_run, [''])
test('T10412', normal, compile_and_run, [''])
test('T13896', normal, compile_and_run, [''])
-test('T13167', normal, compile_and_run, [''])
+test('T13167', fragile_for(16536, ['threaded2']), compile_and_run, [''])
test('T15349', [exit_code(1), expect_broken_for(15349, 'ghci')], compile_and_run, [''])
test('T16111', exit_code(1), compile_and_run, [''])
=====================================
libraries/ghc-heap/tests/all.T
=====================================
@@ -7,5 +7,5 @@ test('heap_all',
],
compile_and_run, [''])
test('closure_size',
- omit_ways(['ghci', 'hpc', 'prof']),
+ [omit_ways(['ghci', 'hpc', 'prof']), expect_broken_for(16544, ['dyn', 'optasm', 'threaded2'])],
compile_and_run, [''])
=====================================
libraries/ghc-heap/tests/closure_size.hs
=====================================
@@ -1,6 +1,7 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE MagicHash #-}
import Control.Monad
import Type.Reflection
@@ -17,12 +18,17 @@ assertSize !x expected = do
putStrLn $ prettyCallStack callStack
{-# NOINLINE assertSize #-}
-pap :: Int -> Char -> Int
+pap :: Int -> Maybe Char -> Int
pap x _ = x
{-# NOINLINE pap #-}
main :: IO ()
main = do
+ -- Ensure that GHC can't turn PAP into a FUN (see #16531)
+ let x :: Int
+ x = 42
+ {-# NOINLINE x #-}
+
assertSize 'a' 2
assertSize (Just ()) 2
assertSize (Nothing :: Maybe ()) 2
@@ -30,5 +36,5 @@ main = do
assertSize ((1,2,3) :: (Int,Int,Int)) 4
assertSize (id :: Int -> Int) 1
assertSize (fst :: (Int,Int) -> Int) 1
- assertSize (pap 1) 2
+ assertSize (pap x) 2
=====================================
libraries/process
=====================================
@@ -1 +1 @@
-Subproject commit d860209e53c1b40b7c251fc8378886bbcb394402
+Subproject commit 5c81524694ceaf8523a1846718a7a7c3f402124f
=====================================
libraries/unix
=====================================
@@ -1 +1 @@
-Subproject commit a102df29c107e8f853129dd40fbbb487e1818149
+Subproject commit a67b5e9e70a2a0c438d4f186fda9f38409ff1435
=====================================
testsuite/driver/testlib.py
=====================================
@@ -258,14 +258,14 @@ def fragile( bug ):
return helper
-def fragile_for( name, opts, bug, ways ):
+def fragile_for( bug, ways ):
"""
Indicates that the test should be skipped due to fragility in the given
test ways as documented in the given ticket.
"""
def helper( name, opts, bug=bug, ways=ways ):
record_broken(name, opts, bug)
- opts.omit_ways = ways
+ opts.omit_ways += ways
return helper
@@ -275,7 +275,8 @@ def omit_ways( ways ):
return lambda name, opts, w=ways: _omit_ways( name, opts, w )
def _omit_ways( name, opts, ways ):
- opts.omit_ways = ways
+ assert ways.__class__ is list
+ opts.omit_ways += ways
# -----
@@ -1408,7 +1409,6 @@ def simple_run(name, way, prog, extra_run_opts):
return failBecause('bad stderr')
if not (opts.ignore_stdout or stdout_ok(name, way)):
return failBecause('bad stdout')
-
check_hp = '-h' in my_rts_flags and opts.check_hp
check_prof = '-p' in my_rts_flags
=====================================
testsuite/tests/concurrent/should_run/all.T
=====================================
@@ -239,7 +239,7 @@ test('conc067', ignore_stdout, compile_and_run, [''])
# omit threaded2, the behaviour of this test is non-deterministic with more
# than one CPU.
-test('conc068', [ omit_ways('threaded2'), exit_code(1) ], compile_and_run, [''])
+test('conc068', [ omit_ways(['threaded2']), exit_code(1) ], compile_and_run, [''])
test('setnumcapabilities001',
[ only_ways(['threaded1','threaded2']),
=====================================
testsuite/tests/dependent/should_compile/all.T
=====================================
@@ -40,7 +40,7 @@ test('T12742', normal, compile, [''])
# (1) Use -fexternal-interpreter, or
# (2) Build the program twice: once with -dynamic, and then
# with -prof using -osuf to set a different object file suffix.
-test('T13910', omit_ways(['profasm']), compile, [''])
+test('T13910', [expect_broken_for(16537, ['optasm']), omit_ways(['profasm'])], compile, [''])
test('T13938', [extra_files(['T13938a.hs'])], makefile_test, ['T13938'])
test('T14556', normal, compile, [''])
test('T14720', normal, compile, [''])
=====================================
testsuite/tests/lib/integer/all.T
=====================================
@@ -1,8 +1,8 @@
test('integerBits', normal, compile_and_run, [''])
test('integerConversions', normal, compile_and_run, [''])
# skip ghci as it doesn't support unboxed tuples
-test('integerGmpInternals', [reqlib('integer-gmp'), omit_ways('ghci')], compile_and_run, [''])
-test('plusMinusInteger', [omit_ways('ghci')], compile_and_run, [''])
+test('integerGmpInternals', [reqlib('integer-gmp'), omit_ways(['ghci'])], compile_and_run, [''])
+test('plusMinusInteger', [omit_ways(['ghci'])], compile_and_run, [''])
test('integerConstantFolding', normal, makefile_test, ['integerConstantFolding'])
test('fromToInteger', [], makefile_test, ['fromToInteger'])
test('IntegerConversionRules', [], makefile_test, ['IntegerConversionRules'])
=====================================
testsuite/tests/primops/should_run/all.T
=====================================
@@ -20,7 +20,9 @@ test('CmpInt8', normal, compile_and_run, [''])
test('CmpWord8', normal, compile_and_run, [''])
test('ShowPrim', normal, compile_and_run, [''])
-test('ArithInt16', normal, compile_and_run, [''])
-test('ArithWord16', normal, compile_and_run, [''])
+# These two tests use unboxed tuples, which GHCi doesn't support
+test('ArithInt16', omit_ways(['ghci']), compile_and_run, [''])
+test('ArithWord16', omit_ways(['ghci']), compile_and_run, [''])
+
test('CmpInt16', normal, compile_and_run, [''])
-test('CmpWord16', normal, compile_and_run, [''])
\ No newline at end of file
+test('CmpWord16', normal, compile_and_run, [''])
=====================================
testsuite/tests/programs/barton-mangler-bug/test.T
=====================================
@@ -8,7 +8,7 @@ test('barton-mangler-bug',
'Plot.hi', 'Plot.o',
'PlotExample.hi', 'PlotExample.o',
'TypesettingTricks.hi', 'TypesettingTricks.o']),
- omit_ways('debug') # Fails for debug way due to annotation linting timeout
+ omit_ways(['debug']) # Fails for debug way due to annotation linting timeout
],
multimod_compile_and_run, ['Main', ''])
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -73,7 +73,7 @@ test('T2047', [ignore_stdout, extra_run_opts('+RTS -c -RTS')],
# Blackhole-detection test.
# Skip GHCi due to #2786
test('T2783', [ omit_ways(['ghci']), exit_code(1)
- , expect_broken_for(2783, ['threaded1'])
+ , fragile_for(2783, ['threaded1'])
], compile_and_run, [''])
# Test the work-stealing deque implementation. We run this test in
@@ -93,7 +93,7 @@ test('stack002', [extra_files(['stack001.hs']),
# run this test with very small stack chunks to exercise the stack
# overflow/underflow machinery.
-test('stack003', [ omit_ways('ghci'), # uses unboxed tuples
+test('stack003', [ omit_ways(['ghci']), # uses unboxed tuples
extra_run_opts('500000 +RTS -kc1k -kb100 -K96m -RTS') ],
compile_and_run, [''])
@@ -272,7 +272,8 @@ test('T7815', [ multi_cpu_race,
test('ffishutdown', [ignore_stderr, only_ways(['threaded1','threaded2'])],
compile_and_run, [''])
-test('T7919', [when(fast(), skip), omit_ways(prof_ways)], compile_and_run,
+# Times out in ghci way
+test('T7919', [when(fast(), skip), omit_ways(['ghci'] + prof_ways)], compile_and_run,
[config.ghc_th_way_flags])
test('T8035', normal, compile_and_run, [''])
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -275,7 +275,7 @@ test('T14140',
normal,
makefile_test, ['T14140'])
-test('T14272', normal, compile, [''])
+test('T14272', expect_broken_for(16539, ['optasm']), compile, [''])
test('T14270a', normal, compile, [''])
test('T14152', [ only_ways(['optasm']), check_errmsg(r'dead code') ], compile, ['-ddump-simpl'])
test('T14152a', [extra_files(['T14152.hs']), pre_cmd('cp T14152.hs T14152a.hs'),
=====================================
testsuite/tests/th/all.T
=====================================
@@ -467,7 +467,10 @@ test('T15437', expect_broken(15437), multimod_compile,
test('T15985', normal, compile, [''])
test('T16133', normal, compile_fail, [''])
test('T15471', normal, multimod_compile, ['T15471.hs', '-v0'])
-test('T16180', normal, compile_and_run, ['-package ghc'])
+test('T16180',
+ [when(llvm_build(), expect_broken_for(16541, ['ext-interp']),
+ expect_broken_for(16541, ['ghci'])],
+ compile_and_run, ['-package ghc'])
test('T16183', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
test('T16195', normal, multimod_compile, ['T16195.hs', '-v0'])
test('T16293b', normal, compile, [''])
=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -659,7 +659,7 @@ test('T15586', normal, compile, [''])
test('T15368', normal, compile, ['-fdefer-type-errors'])
test('T15645', normal, compile, ['-Wwarn=missing-monadfail-instances'])
test('T15778', normal, compile, [''])
-test('T14761c', normal, compile, [''])
+test('T14761c', expect_broken_for(16540, ['hpc', 'optasm']), compile, [''])
test('T16008', normal, compile, [''])
test('T16033', normal, compile, [''])
test('T16141', normal, compile, ['-O'])
=====================================
testsuite/tests/typecheck/should_run/all.T
=====================================
@@ -35,7 +35,7 @@ test('tcrun018', normal, compile_and_run, [''])
test('tcrun019', normal, compile_and_run, [''])
test('tcrun020', normal, compile_and_run, [''])
test('tcrun021', normal, compile_and_run, ['-package containers'])
-test('tcrun022', omit_ways(['ghci']), compile_and_run, ['-O'])
+test('tcrun022', omit_ways(['hpc', 'ghci']), compile_and_run, ['-O'])
test('tcrun023', [when(doing_ghci(), extra_hc_opts('-fobject-code'))],
compile_and_run, ['-O'])
test('tcrun024', normal, compile_and_run, ['-O'])
@@ -96,7 +96,7 @@ test('T6117', normal, compile_and_run, [''])
test('T5751', normal, compile_and_run, [''])
test('T5913', normal, compile_and_run, [''])
test('T7748', normal, compile_and_run, [''])
-test('T7861', [omit_ways('debug'), exit_code(1)], compile_and_run, [''])
+test('T7861', [omit_ways(['debug']), exit_code(1)], compile_and_run, [''])
test('TcTypeNatSimpleRun', normal, compile_and_run, [''])
test('TcTypeSymbolSimpleRun', normal, compile_and_run, [''])
test('T8119', normal, ghci_script, ['T8119.script'])
=====================================
testsuite/tests/utils/should_run/all.T
=====================================
@@ -1,6 +1,6 @@
test('T14854',
[only_ways(threaded_ways),
- omit_ways('ghci'),
+ omit_ways(['ghci']),
reqlib('random'),
ignore_stderr],
compile_and_run,
=====================================
testsuite/tests/warnings/should_compile/T16282/T16282.hs
=====================================
@@ -0,0 +1,14 @@
+import Data.Map
+
+-- If someone improves the specializer so that
+-- GHC no longer misses the specialization below,
+-- then this test will fail, as it expects a warning
+-- to be issued.
+-- Another reason this could fail is due to spelling:
+-- the test checks for the "specialisation" spelling,
+-- but due to changes in how the warnings are listed in DynFalgs.hs
+-- the compiler may spit out the "specialization" spelling.
+main :: IO ()
+main = do
+ let m = [] :: [Map String Bool]
+ mapM_ print m
=====================================
testsuite/tests/warnings/should_compile/T16282/T16282.stderr
=====================================
@@ -0,0 +1,5 @@
+
+T16282.hs: warning: [-Wall-missed-specialisations]
+ Could not specialise imported function ‘Data.Map.Internal.$w$cshowsPrec’
+ when specialising ‘Data.Map.Internal.$fShowMap_$cshowsPrec’
+ Probable fix: add INLINABLE pragma on ‘Data.Map.Internal.$w$cshowsPrec’
=====================================
testsuite/tests/warnings/should_compile/T16282/all.T
=====================================
@@ -0,0 +1 @@
+test('T16282', normal, compile, ['-O2 -Wall-missed-specialisations'])
\ No newline at end of file
=====================================
testsuite/tests/warnings/should_compile/all.T
=====================================
@@ -25,4 +25,4 @@ test('MissingMod', normal, multimod_compile, ['MissingMod', '-Wmissing-home-modu
test('StarBinder', normal, compile, [''])
-test('Overflow', normal, compile, [''])
+test('Overflow', expect_broken_for(16543, ['hpc']), compile, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/1ac79339a782c850a5affdd75d56b192d1565414...d7106e24e223cb38baf6dde90545a4208250591d
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/1ac79339a782c850a5affdd75d56b192d1565414...d7106e24e223cb38baf6dde90545a4208250591d
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/20190407/31eb2896/attachment-0001.html>
More information about the ghc-commits
mailing list