summaryrefslogtreecommitdiff
path: root/testsuite
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2014-07-01 13:31:18 +0100
committerSimon Peyton Jones <simonpj@microsoft.com>2014-07-01 15:23:55 +0100
commitd6ee82b29598dcc1028773dd987b7a2fb17519b7 (patch)
treee0465a736d3d59c6ada3ba5730d5f1bb439e577f /testsuite
parentdb64180896b395283f443d66a308048c605b217d (diff)
downloadhaskell-d6ee82b29598dcc1028773dd987b7a2fb17519b7.tar.gz
Fix demand analyser for unboxed types
This is a tricky case exposed by Trac #9254. I'm surprised it hasn't shown up before, because it's happens when you use unsafePerformIO in the right way. Anyway, fixed now. See Note [Analysing with absent demand] in Demand.lhs
Diffstat (limited to 'testsuite')
-rw-r--r--testsuite/tests/stranal/should_run/T9254.hs20
-rw-r--r--testsuite/tests/stranal/should_run/T9254.stdout1
-rw-r--r--testsuite/tests/stranal/should_run/all.T1
3 files changed, 22 insertions, 0 deletions
diff --git a/testsuite/tests/stranal/should_run/T9254.hs b/testsuite/tests/stranal/should_run/T9254.hs
new file mode 100644
index 0000000000..279eb5c1ec
--- /dev/null
+++ b/testsuite/tests/stranal/should_run/T9254.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+module Main where
+import GHC.Exts
+
+f :: (() -> (# Int#, () #)) -> ()
+{-# NOINLINE f #-}
+-- Strictness signature was (7.8.2)
+-- <C(S(LS)), 1*C1(U(A,1*U()))>
+-- I.e. calls k, but discards first component of result
+f k = case k () of (# _, r #) -> r
+
+g :: Int -> ()
+g y = f (\n -> (# case y of I# y2 -> h (h (h (h (h (h (h y2)))))), n #))
+ -- RHS is big enough to force worker/wrapper
+
+{-# NOINLINE h #-}
+h :: Int# -> Int#
+h n = n +# 1#
+
+main = print (g 1)
diff --git a/testsuite/tests/stranal/should_run/T9254.stdout b/testsuite/tests/stranal/should_run/T9254.stdout
new file mode 100644
index 0000000000..6a452c185a
--- /dev/null
+++ b/testsuite/tests/stranal/should_run/T9254.stdout
@@ -0,0 +1 @@
+()
diff --git a/testsuite/tests/stranal/should_run/all.T b/testsuite/tests/stranal/should_run/all.T
index 0c43aac8c4..2ca65b5110 100644
--- a/testsuite/tests/stranal/should_run/all.T
+++ b/testsuite/tests/stranal/should_run/all.T
@@ -7,3 +7,4 @@ test('strun003', normal, compile_and_run, [''])
test('strun004', normal, compile_and_run, [''])
test('T2756b', normal, compile_and_run, [''])
test('T7649', normal, compile_and_run, [''])
+test('T9254', normal, compile_and_run, [''])