summaryrefslogtreecommitdiff
path: root/testsuite/tests/simplStg/should_run
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests/simplStg/should_run')
-rw-r--r--testsuite/tests/simplStg/should_run/Makefile3
-rw-r--r--testsuite/tests/simplStg/should_run/T9291.hs58
-rw-r--r--testsuite/tests/simplStg/should_run/T9291.stdout5
-rw-r--r--testsuite/tests/simplStg/should_run/all.T12
4 files changed, 78 insertions, 0 deletions
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, [''])