From 97ec37cc28e8aa39aa7ae0b1f02d695338656009 Mon Sep 17 00:00:00 2001
From: Sebastian Graf <sebastian.graf@kit.edu>
Date: Mon, 20 Nov 2023 11:02:34 +0100
Subject: [PATCH] Add regression test for #6070
Fixes #6070.
---
testsuite/tests/stranal/sigs/T6070.hs | 13 +++++++++++++
testsuite/tests/stranal/sigs/T6070.stderr | 18 ++++++++++++++++++
testsuite/tests/stranal/sigs/all.T | 1 +
3 files changed, 32 insertions(+)
create mode 100644 testsuite/tests/stranal/sigs/T6070.hs
create mode 100644 testsuite/tests/stranal/sigs/T6070.stderr
diff --git a/testsuite/tests/stranal/sigs/T6070.hs b/testsuite/tests/stranal/sigs/T6070.hs
new file mode 100644
index 000000000000..7eb679fa5262
--- /dev/null
+++ b/testsuite/tests/stranal/sigs/T6070.hs
@@ -0,0 +1,13 @@
+module T6070 where
+
+import qualified Data.Map as M
+
+-- Should unbox `x`, so signature 1!P(..,..)
+h :: (Int, Int) -> Int -> (Int, Int)
+h x y = if y > 10
+ then x
+ else h (case h x 0 of (y1, y2) -> (y2, y1)) (y + 1)
+
+-- Should unbox `(a,b)`, so signature 1!P(..,..)
+c :: M.Map Int Int -> (Int, Int)
+c m = M.foldrWithKey (\k v (a, b) -> if k + v > 2 then (a, b) else (b, a)) (0, 1) m
diff --git a/testsuite/tests/stranal/sigs/T6070.stderr b/testsuite/tests/stranal/sigs/T6070.stderr
new file mode 100644
index 000000000000..891cf6c8d699
--- /dev/null
+++ b/testsuite/tests/stranal/sigs/T6070.stderr
@@ -0,0 +1,18 @@
+
+==================== Strictness signatures ====================
+T6070.c: <1L>
+T6070.h: <1!P(L,L)><1!P(L)>
+
+
+
+==================== Cpr signatures ====================
+T6070.c: 1
+T6070.h: 1
+
+
+
+==================== Strictness signatures ====================
+T6070.c: <1L>
+T6070.h: <1!P(L,L)><1!P(L)>
+
+
diff --git a/testsuite/tests/stranal/sigs/all.T b/testsuite/tests/stranal/sigs/all.T
index 3392f931c197..bef6797b7d2e 100644
--- a/testsuite/tests/stranal/sigs/all.T
+++ b/testsuite/tests/stranal/sigs/all.T
@@ -18,6 +18,7 @@ test('DmdAnalGADTs', normal, compile, [''])
test('T12370', normal, compile, [''])
test('NewtypeArity', normal, compile, [''])
test('T5075', normal, compile, [''])
+test('T6070', normal, compile, [''])
test('T17932', normal, compile, [''])
test('T13380c', expect_broken('!3014'), compile, [''])
test('T13380f', normal, compile, [''])
--
GitLab