Demand Analyser testcase: Unsaturated functions

3 files changed, 39 insertions, 0 deletions

diff --git a/testsuite/tests/stranal/sigs/UnsatFun.hs b/testsuite/tests/stranal/sigs/UnsatFun.hs
new file mode 100644
index 0000000000..23ba6426cd
--- /dev/null
+++ b/testsuite/tests/stranal/sigs/UnsatFun.hs
@@ -0,0 +1,29 @@
+module UnsatFun where
+
+-- Here we test how a partially applied function (f x)
+-- with a bottom result affects the strictness signature
+-- when used strictly (g) and lazily (g')
+--
+-- In both cases, the parameter x should not be absent
+
+f :: Int -> Int -> Int
+f x y = error (show x)
+{-# NOINLINE f #-}
+
+h :: (Int -> Int) -> Int
+h f = f 2
+{-# NOINLINE h #-}
+
+h2 :: Bool -> (Int -> Int) -> Int
+h2 True  _ = 0
+h2 False f = f 2
+{-# NOINLINE h2 #-}
+
+-- Should get a bottom result
+g :: Int -> Int
+g x = let f' = f x
+      in h f'
+
+g2 :: Int -> Int
+g2 x = let f' = f x
+       in h2 True f'
diff --git a/testsuite/tests/stranal/sigs/UnsatFun.stderr b/testsuite/tests/stranal/sigs/UnsatFun.stderr
new file mode 100644
index 0000000000..3df7ac830a
--- /dev/null
+++ b/testsuite/tests/stranal/sigs/UnsatFun.stderr
@@ -0,0 +1,9 @@
+
+==================== Strictness signatures ====================
+UnsatFun.h: <C(S),1*C1(U(U))>
+UnsatFun.h2: <S,1*U><L,1*C1(U(U))>
+UnsatFun.f: <B,1*U(U)><B,A>b
+UnsatFun.g2: <L,U>
+UnsatFun.g: <B,1*U(U)>b
+
+
diff --git a/testsuite/tests/stranal/sigs/all.T b/testsuite/tests/stranal/sigs/all.T
index ca47b529d2..3657432cdf 100644
--- a/testsuite/tests/stranal/sigs/all.T
+++ b/testsuite/tests/stranal/sigs/all.T
@@ -12,3 +12,4 @@ test('T8569', expect_broken(8569), compile, [''])
 test('HyperStrUse', normal, compile, [''])
 test('T8598', normal, compile, [''])
 test('FacState', expect_broken(1600), compile, [''])
+test('UnsatFun', normal, compile, [''])