6 files changed, 47 insertions, 0 deletions
diff --git a/testsuite/tests/arityanal/should_compile/T21755.hs b/testsuite/tests/arityanal/should_compile/T21755.hs
new file mode 100644
index 0000000000..c21557125c
--- /dev/null
+++ b/testsuite/tests/arityanal/should_compile/T21755.hs
@@ -0,0 +1,11 @@
+module T21755 where
+
+mySum :: [Int] -> Int
+mySum [] = 0
+mySum (x:xs) = x + mySum xs
+
+f :: Int -> (Int -> Int) -> Int -> Int
+f k z =
+    if even (mySum [0..k])
+      then \n -> n + 1
+      else \n -> z n
diff --git a/testsuite/tests/arityanal/should_compile/T21755.stderr b/testsuite/tests/arityanal/should_compile/T21755.stderr
new file mode 100644
index 0000000000..0519ecba6e
--- /dev/null
+++ b/testsuite/tests/arityanal/should_compile/T21755.stderr
@@ -0,0 +1 @@
+ 
+\ No newline at end of file
diff --git a/testsuite/tests/arityanal/should_compile/all.T b/testsuite/tests/arityanal/should_compile/all.T
index cb962dd32a..6124bf12c9 100644
--- a/testsuite/tests/arityanal/should_compile/all.T
+++ b/testsuite/tests/arityanal/should_compile/all.T
@@ -21,3 +21,4 @@ test('Arity16', [ only_ways(['optasm']), grep_errmsg('Arity=') ], compile, ['-dn
 test('T18793', [ only_ways(['optasm']), grep_errmsg('Arity=') ], compile, ['-dno-typeable-binds -ddump-simpl -dppr-cols=99999 -dsuppress-uniques'])
 test('T18870', [ only_ways(['optasm']) ], compile, ['-ddebug-output'])
 test('T18937', [ only_ways(['optasm']) ], compile, ['-ddebug-output'])
+test('T21755',  [ grep_errmsg(r'Arity=') ], compile, ['-O -dno-typeable-binds -fno-worker-wrapper'])
diff --git a/testsuite/tests/arityanal/should_run/T21694a.hs b/testsuite/tests/arityanal/should_run/T21694a.hs
new file mode 100644
index 0000000000..ca01c1cb92
--- /dev/null
+++ b/testsuite/tests/arityanal/should_run/T21694a.hs
@@ -0,0 +1,27 @@
+module Main (main) where
+
+import GHC.Exts
+import Control.DeepSeq
+import System.Exit
+
+-- If we eta expand the `False` branch will return
+-- a lambda \eta -> z instead of z.
+-- This behaves differently if the z argument is a bottom.
+-- We used to assume that a oneshot annotation would mean
+-- we could eta-expand on *all* branches. But this is clearly
+-- not sound in this case. So we test for this here.
+{-# NOINLINE f #-}
+f :: Bool -> (Int -> Int) -> Int -> Int
+f b z =
+    case b of
+        True -> oneShot $ \n -> n + 1
+        False -> z
+
+
+
+main :: IO Int
+main = do
+    return $! force $! f False (error "Urkh! But expected!")
+    return 0
+
+
diff --git a/testsuite/tests/arityanal/should_run/T21694a.stderr b/testsuite/tests/arityanal/should_run/T21694a.stderr
new file mode 100644
index 0000000000..8a0fd0cc91
--- /dev/null
+++ b/testsuite/tests/arityanal/should_run/T21694a.stderr
@@ -0,0 +1,3 @@
+T21694a: Urkh! But expected!
+CallStack (from HasCallStack):
+  error, called at T21694a.hs:23:33 in main:Main
diff --git a/testsuite/tests/arityanal/should_run/all.T b/testsuite/tests/arityanal/should_run/all.T
index a6b06fbb15..c808036854 100644
--- a/testsuite/tests/arityanal/should_run/all.T
+++ b/testsuite/tests/arityanal/should_run/all.T
@@ -1,2 +1,6 @@
+# "Unit tests"
+
 # Regression tests
 test('T21652', [ only_ways(['optasm']) ], compile_and_run, [''])
+test('T21694a', [ only_ways(['optasm']), exit_code(1) ], compile_and_run, ['-fpedantic-bottoms'])
+