Commit 3a34b5c3 authored by Joachim Breitner's avatar Joachim Breitner

Add a test case for #11731.

parent 20f90560
......@@ -1475,6 +1475,7 @@ mk/ghcconfig*_test___spaces_ghc*.exe.mk
/tests/simplCore/should_run/T5997
/tests/simplCore/should_run/T7101
/tests/simplCore/should_run/T7924
/tests/simplCore/should_run/T11731
/tests/simplCore/should_run/T9128
/tests/simplCore/should_run/T9390
/tests/simplCore/should_run/runST
......
module Main (main ) where
import Debug.Trace
foo :: (a,b) -> a
foo (x,y) = x
{-# NOINLINE foo #-}
wwMe :: Int -> (Int,Int) -> (Int, Int)
wwMe 0 p =
let a = fst p
b = snd p
-- This ensure sharing of b, as seen by the demand analyzer
in foo p `seq`
-- This ensures that wwMe is strict in the tuple, but that the tuple
-- is preserved.
(b + a, a + b)
wwMe n p = wwMe (n-1) (0,0)
-- ^ Make it recursive, so that it is attractive to worker-wrapper
go :: Int -> IO ()
go seed = do
let shareMeThunk = trace "Evaluated (should only happen once)" (seed + 1)
{-# NOINLINE shareMeThunk #-}
-- ^ This is the thunk that is wrongly evaluated twice.
let (x,y) = wwMe 0 (seed,shareMeThunk)
(x + y) `seq` return ()
-- ^ Use both components
{-# NOINLINE go #-}
main :: IO ()
main = go 42
Evaluated (should only happen once)
......@@ -71,3 +71,4 @@ test('T9128', normal, compile_and_run, [''])
test('T9390', normal, compile_and_run, [''])
test('T10830', extra_run_opts('+RTS -K100k -RTS'), compile_and_run, [''])
test('T11172', normal, compile_and_run, [''])
test('T11731', expect_broken(11731), compile_and_run, ['-fspec-constr'])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment