[Git][ghc/ghc][wip/slowtest] 12 commits: testsuite: Mark hWaitForInput-accurate-stdin as broken in threaded ways
Ben Gamari
gitlab at gitlab.haskell.org
Fri Apr 5 11:52:33 UTC 2019
Ben Gamari pushed to branch wip/slowtest at Glasgow Haskell Compiler / GHC
Commits:
3125c86e by Ben Gamari at 2019-04-05T11:48:32Z
testsuite: Mark hWaitForInput-accurate-stdin as broken in threaded ways
As noted in #16535.
- - - - -
e4a9eed6 by Ömer Sinan Ağacan at 2019-04-05T11:48:32Z
Skip test ArithInt16 and ArithWord16 in GHCi way
These tests use unboxed tuples, which GHCi doesn't support
- - - - -
d7d845ab by Ben Gamari at 2019-04-05T11:48:32Z
testsuite: Make closureSize less sensitive to optimisation
- - - - -
02f0b702 by Ben Gamari at 2019-04-05T11:48:32Z
process: Skip process005 in ghci way
- - - - -
02bcf96b by Ben Gamari at 2019-04-05T11:48:33Z
testsuite: Mark T13167 as broken in threaded2
As noted in #16536.
- - - - -
09636efc by Ben Gamari at 2019-04-05T11:48:33Z
testsuite: Mark T13910 as broken in optasm
Due to #16537.
- - - - -
e15d3b82 by Ben Gamari at 2019-04-05T11:48:33Z
testsuite: Mark T14272 as broken in optasm
- - - - -
b27767a3 by Ben Gamari at 2019-04-05T11:48:33Z
testsuite: Mark T14761c as broken in hpc and optasm ways
As noted in #16540.
- - - - -
f1b8f2f0 by Ben Gamari at 2019-04-05T11:48:33Z
testsuite: Mark T16180 as broken in ghci way
As noted in #16541.
- - - - -
ab8fb4e5 by Ben Gamari at 2019-04-05T11:48:33Z
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.
- - - - -
14fb0b09 by Ben Gamari at 2019-04-05T11:48:33Z
testsuite: Mark Overflow as broken in hpc way
As noted in #16543.
- - - - -
043c00bc by Ben Gamari at 2019-04-05T11:51:44Z
testsuite: Mark closure_size as broken in threaded2, optasm, dyn ways
As noted in #16531.
- - - - -
12 changed files:
- libraries/base/tests/all.T
- libraries/ghc-heap/tests/all.T
- libraries/ghc-heap/tests/closure_size.hs
- libraries/process
- testsuite/driver/testlib.py
- testsuite/tests/dependent/should_compile/all.T
- testsuite/tests/primops/should_run/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/warnings/should_compile/all.T
Changes:
=====================================
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,5 +233,5 @@ 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', expect_broken_for(16536, ['threaded2']), compile_and_run, [''])
test('T15349', [exit_code(1), expect_broken_for(15349, 'ghci')], 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 1a6197ff2112ed9849589b348981754ee1d3ca23
=====================================
testsuite/driver/testlib.py
=====================================
@@ -1408,7 +1408,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/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/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/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,7 @@ 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', 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'])
=====================================
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/b58908e0ab93b49303fb7a06db38b397f4a3d684...043c00bc5418d51c94b7a9e346bc9c11e0415825
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/b58908e0ab93b49303fb7a06db38b397f4a3d684...043c00bc5418d51c94b7a9e346bc9c11e0415825
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/20190405/76936a49/attachment-0001.html>
More information about the ghc-commits
mailing list