CprAnal: Two regression testswip/nested-cpr-tests

For #16040 and #2387.

5 files changed, 70 insertions, 0 deletions

diff --git a/testsuite/tests/cpranal/sigs/T16040.hs b/testsuite/tests/cpranal/sigs/T16040.hs
new file mode 100644
index 0000000000..99ad102e9c
--- /dev/null
+++ b/testsuite/tests/cpranal/sigs/T16040.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE BangPatterns #-}
+
+module T16040 where
+
+-- A type to take the place of state
+data X a = X { runX :: !a }
+
+test1 :: Int -> Int
+test1 = \(!i) -> go i where
+    go = \(!i) -> if i > 0
+        then go $! i - 1
+        else i
+{-# NOINLINE test1 #-}
+
+-- | Like 'test1', this function's result should have the CPR property and be
+-- unboxed.
+test2 :: Int -> Int
+test2 = \(!i) -> runX (go i) where
+    go = \(!i) -> if i > 0
+        then go $! i - 1
+        else X i
+{-# NOINLINE test2 #-}
diff --git a/testsuite/tests/cpranal/sigs/T16040.stderr b/testsuite/tests/cpranal/sigs/T16040.stderr
new file mode 100644
index 0000000000..0add7a9671
--- /dev/null
+++ b/testsuite/tests/cpranal/sigs/T16040.stderr
@@ -0,0 +1,7 @@
+
+==================== Cpr signatures ====================
+T16040.runX:
+T16040.test1: 1
+T16040.test2: 1
+
+
diff --git a/testsuite/tests/cpranal/sigs/T2387.hs b/testsuite/tests/cpranal/sigs/T2387.hs
new file mode 100644
index 0000000000..71639dee19
--- /dev/null
+++ b/testsuite/tests/cpranal/sigs/T2387.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE TypeOperators, BangPatterns #-}
+
+module T2387 (mainLoop) where
+
+import Control.Monad.ST
+
+import System.Environment
+
+data (:*:) a b = !a :*: !b
+
+whileLoop :: Int -> ST s Int
+whileLoop = go 0
+ where
+ go !n k
+   | k == 0    = return n
+   | otherwise = go (n+1) (k-1)
+{-# INLINE whileLoop #-}
+
+iter :: Int -> Int -> ST s (Bool :*: Int)
+iter k n = do
+  k' <- whileLoop 40 >>= \k' -> return $! max k k'
+  b <- return (n == 0)
+
+  return $! b :*: k'
+{-# INLINE iter #-}
+
+-- | The returned Int should be unboxed
+mainLoop :: Int -> Int -> ST s Int
+mainLoop k n = do
+  done :*: k' <- iter k n
+
+  if done
+    then return k'
+    else mainLoop k' (n - 1)
diff --git a/testsuite/tests/cpranal/sigs/T2387.stderr b/testsuite/tests/cpranal/sigs/T2387.stderr
new file mode 100644
index 0000000000..9096c64a07
--- /dev/null
+++ b/testsuite/tests/cpranal/sigs/T2387.stderr
@@ -0,0 +1,5 @@
+
+==================== Cpr signatures ====================
+T2387.mainLoop: 1(, 1)
+
+
diff --git a/testsuite/tests/cpranal/sigs/all.T b/testsuite/tests/cpranal/sigs/all.T
index 90a6b9e693..43ab6bb010 100644
--- a/testsuite/tests/cpranal/sigs/all.T
+++ b/testsuite/tests/cpranal/sigs/all.T
@@ -7,6 +7,8 @@ setTestOpts(extra_hc_opts('-dno-typeable-binds -ddump-cpr-signatures -v0'))
 
 test('CaseBinderCPR', normal, compile, [''])
 test('RecDataConCPR', [], multimod_compile, ['RecDataConCPR', ''])
+test('T2387', normal, compile, [''])
+test('T16040', normal, compile, [''])
 test('T19232', normal, compile, [''])
 test('T19398', normal, compile, [''])
 test('T19822', normal, compile, [''])