test Right -> Just

1 files changed, 71 insertions, 0 deletions

diff --git a/testsuite/tests/simplStg/should_run/T13861.hs b/testsuite/tests/simplStg/should_run/T13861.hs
new file mode 100644
index 0000000..90a5d67
--- /dev/null
+++ b/testsuite/tests/simplStg/should_run/T13861.hs
@@ -0,0 +1,71 @@
+{-# LANGUAGE MagicHash, BangPatterns #-}
+import GHC.Exts
+import Unsafe.Coerce
+
+foo :: Either Int a -> Maybe a
+foo (Right x) = Just x
+foo _ = Nothing
+{-# NOINLINE foo #-}
+
+bar :: a -> (Either Int a, Maybe a)
+bar x = (Right x, Just x)
+{-# NOINLINE bar #-}
+
+data E a b = L a | R !b
+
+foo' :: E Int a -> Maybe a
+foo' (R x) = Just x
+foo' _ = Nothing
+{-# NOINLINE foo' #-}
+
+
+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 (r30, r31) = (R 'l', foo' r30)
+    (same $! r30) $! r31
+    -- 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
+    case r3 of
+      Just b -> print ("YAY", b)
+      Nothing -> print "BAD"
+{-# NOINLINE test #-}
+
+main = test "foo"
+
+same :: a -> b -> IO ()
+same x y = case reallyUnsafePtrEquality# (unsafeCoerce x) y of
+    1# -> putStrLn "yes"
+    _  -> putStrLn "no"