diff options
| -rw-r--r-- | testsuite/.gitignore | 1 | ||||
| -rw-r--r-- | testsuite/tests/simplCore/should_run/T11731.hs | 36 | ||||
| -rw-r--r-- | testsuite/tests/simplCore/should_run/T11731.stderr | 1 | ||||
| -rw-r--r-- | testsuite/tests/simplCore/should_run/all.T | 1 |
4 files changed, 39 insertions, 0 deletions
diff --git a/testsuite/.gitignore b/testsuite/.gitignore index 655e3da3c8..e1f1822159 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -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 diff --git a/testsuite/tests/simplCore/should_run/T11731.hs b/testsuite/tests/simplCore/should_run/T11731.hs new file mode 100644 index 0000000000..e148507798 --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T11731.hs @@ -0,0 +1,36 @@ +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 diff --git a/testsuite/tests/simplCore/should_run/T11731.stderr b/testsuite/tests/simplCore/should_run/T11731.stderr new file mode 100644 index 0000000000..8d1fc6069e --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T11731.stderr @@ -0,0 +1 @@ +Evaluated (should only happen once) diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T index 9c15b0ff54..042c0974d9 100644 --- a/testsuite/tests/simplCore/should_run/all.T +++ b/testsuite/tests/simplCore/should_run/all.T @@ -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']) |