[commit: ghc] wip/T13861: Another identity test (e51bf6d)

[git at git.haskell.org]

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

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

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

commit e51bf6d849e9f498e59878adde17ae6153830127
Author: Gabor Greif <ggreif at gmail.com>
Date:   Fri Dec 29 13:25:42 2017 +0100

    Another identity test


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

e51bf6d849e9f498e59878adde17ae6153830127
 testsuite/tests/simplStg/should_run/T13861.hs     | 11 ++++++++++-
 testsuite/tests/simplStg/should_run/T13861.stdout |  1 +
 2 files changed, 11 insertions(+), 1 deletion(-)

diff --git a/testsuite/tests/simplStg/should_run/T13861.hs b/testsuite/tests/simplStg/should_run/T13861.hs
index 0622899..6c4f5a0 100644
--- a/testsuite/tests/simplStg/should_run/T13861.hs
+++ b/testsuite/tests/simplStg/should_run/T13861.hs
@@ -36,12 +36,19 @@ quux' Fal = True
 quux' _ = False
 {-# NOINLINE quux' #-}
 
--- the 'Fal' and default case should be lumped together
+-- the 'Dunno' and default case (i.e. 'Tru') should be lumped together
 lump Fal = True
 lump Dunno = unsafeCoerce Tru
 lump _ = False
 {-# NOINLINE lump #-}
 
+-- the 'One' and default case should be lumped together
+data Boom = Zero | One | Two | Three
+lump' One = Fal
+lump' Three = Tru
+lump' other = unsafeCoerce other -- Zero -> Tru, Two -> Dunno
+{-# NOINLINE lump' #-}
+
 
 nested :: Either Int (Either Int a) -> Either Bool (Maybe a)
 nested (Right (Right x)) = Right (Just x)
@@ -106,6 +113,8 @@ test x = do
     (same $! r56) $! r57                -- yes, lump is STG identity on 'Tru'
     let (r58, r59) = (Fal, lump r58)
     (same $! r58) $! r59                -- yes, lump is STG identity on 'Fal'
+    let (r60, r61) = (Two, lump' r60)
+    (same $! r60) $! r61                -- yes, lump' is STG identity on 'Two'
 
     let (r4,_) = bar r1
     let r5 = nested r4
diff --git a/testsuite/tests/simplStg/should_run/T13861.stdout b/testsuite/tests/simplStg/should_run/T13861.stdout
index 155d985..2a61dc3 100644
--- a/testsuite/tests/simplStg/should_run/T13861.stdout
+++ b/testsuite/tests/simplStg/should_run/T13861.stdout
@@ -13,5 +13,6 @@ yes
 yes
 yes
 yes
+yes
 no
 ("YAY","foo")