5 files changed, 81 insertions, 0 deletions
diff --git a/testsuite/tests/simplStg/Makefile b/testsuite/tests/simplStg/Makefile
new file mode 100644
index 0000000000..9a36a1c5fe
--- /dev/null
+++ b/testsuite/tests/simplStg/Makefile
@@ -0,0 +1,3 @@
+TOP=../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/simplStg/should_run/Makefile b/testsuite/tests/simplStg/should_run/Makefile
new file mode 100644
index 0000000000..9101fbd40a
--- /dev/null
+++ b/testsuite/tests/simplStg/should_run/Makefile
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/simplStg/should_run/T9291.hs b/testsuite/tests/simplStg/should_run/T9291.hs
new file mode 100644
index 0000000000..db2ce75da2
--- /dev/null
+++ b/testsuite/tests/simplStg/should_run/T9291.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE MagicHash #-}
+import GHC.Exts
+import Unsafe.Coerce
+
+foo :: Either Int a -> Either Bool a
+foo (Right x) = Right x
+foo _ = Left True
+{-# NOINLINE foo #-}
+
+bar :: a -> (Either Int a, Either Bool a)
+bar x = (Right x, Right x)
+{-# NOINLINE bar #-}
+
+nested :: Either Int (Either Int a) -> Either Bool (Either Bool a)
+nested (Right (Right x)) = Right (Right x)
+nested _ = Left True
+{-# NOINLINE nested #-}
+
+
+-- CSE in a recursive group
+data Tree x = T x (Either Int (Tree x)) (Either Bool (Tree x))
+rec1 :: x -> Tree x
+rec1 x =
+    let t = T x r1 r2
+        r1 = Right t
+        r2 = Right t
+    in t
+{-# NOINLINE rec1 #-}
+
+-- Not yet supported! (and tricky)
+data Stream a b x = S x (Stream b a x)
+rec2 :: x -> Stream a b x
+rec2 x =
+    let s1 = S x s2
+        s2 = S x s1
+    in s1
+{-# NOINLINE rec2 #-}
+
+test x = do
+    let (r1,r2) = bar x
+    (same $! r1) $! r2
+    let r3 = foo r1
+    (same $! r1) $! r3
+    let (r4,_) = bar r1
+    let r5 = nested r4
+    (same $! r4) $! r5
+    let (T _ r6 r7) = rec1 x
+    (same $! r6) $! r7
+    let s1@(S _ s2) = rec2 x
+    (same $! s1) $! s2
+{-# NOINLINE test #-}
+
+main = test "foo"
+
+same :: a -> b -> IO ()
+same x y = case reallyUnsafePtrEquality# (unsafeCoerce x) y of
+    1# -> putStrLn "yes"
+    _  -> putStrLn "no"
diff --git a/testsuite/tests/simplStg/should_run/T9291.stdout b/testsuite/tests/simplStg/should_run/T9291.stdout
new file mode 100644
index 0000000000..aa14978324
--- /dev/null
+++ b/testsuite/tests/simplStg/should_run/T9291.stdout
@@ -0,0 +1,5 @@
+yes
+yes
+yes
+yes
+no
diff --git a/testsuite/tests/simplStg/should_run/all.T b/testsuite/tests/simplStg/should_run/all.T
new file mode 100644
index 0000000000..3d4f4a3763
--- /dev/null
+++ b/testsuite/tests/simplStg/should_run/all.T
@@ -0,0 +1,12 @@
+# Args to compile_and_run are:
+#	extra compile flags
+#	extra run flags
+#	expected process return value, if not zero
+
+# Only compile with optimisation
+def f( name, opts ):
+  opts.only_ways = ['optasm']
+
+setTestOpts(f)
+
+test('T9291', normal, compile_and_run, [''])