[commit: ghc] wip/T13861: test Right -> Just (d4a36d3)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/T13861
Link       : http://ghc.haskell.org/trac/ghc/changeset/d4a36d382ab510e3770bab2515a2a3850c96029a/ghc

>---------------------------------------------------------------

commit d4a36d382ab510e3770bab2515a2a3850c96029a
Author: Gabor Greif <ggreif at gmail.com>
Date:   Sat Jul 29 16:43:04 2017 +0200

    test Right -> Just


>---------------------------------------------------------------

d4a36d382ab510e3770bab2515a2a3850c96029a
 .../simplStg/should_run/{T9291.hs => T13861.hs}    | 39 ++++++++++++++--------
 1 file changed, 26 insertions(+), 13 deletions(-)

diff --git a/testsuite/tests/simplStg/should_run/T9291.hs b/testsuite/tests/simplStg/should_run/T13861.hs
similarity index 59%
copy from testsuite/tests/simplStg/should_run/T9291.hs
copy to testsuite/tests/simplStg/should_run/T13861.hs
index db2ce75..90a5d67 100644
--- a/testsuite/tests/simplStg/should_run/T9291.hs
+++ b/testsuite/tests/simplStg/should_run/T13861.hs
@@ -1,16 +1,24 @@
-{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE MagicHash, BangPatterns #-}
 import GHC.Exts
 import Unsafe.Coerce
 
-foo :: Either Int a -> Either Bool a
-foo (Right x) = Right x
-foo _ = Left True
+foo :: Either Int a -> Maybe a
+foo (Right x) = Just x
+foo _ = Nothing
 {-# NOINLINE foo #-}
 
-bar :: a -> (Either Int a, Either Bool a)
-bar x = (Right x, Right x)
+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
@@ -41,13 +49,18 @@ test x = do
     (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
+    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"