[commit: ghc] master: Add a test for #14140 (0ebc8dc)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/0ebc8dc3525ddaa04a0c9e4c0c1aef70fd3fe725/ghc

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

commit 0ebc8dc3525ddaa04a0c9e4c0c1aef70fd3fe725
Author: David Feuer <david.feuer at gmail.com>
Date:   Tue Sep 12 17:21:46 2017 -0400

    Add a test for #14140
    
    This issue seems to have been fixed by
    193664d42dbceadaa1e4689dfa17ff1cf5a405a0 (Re-engineer caseRules
    to add tagToEnum/dataToTag) but I don't think anyone realized
    that.
    
    Reviewers: simonpj, austin, bgamari
    
    Reviewed By: simonpj
    
    Subscribers: rwbarton, thomie
    
    GHC Trac Issues: #14140
    
    Differential Revision: https://phabricator.haskell.org/D3934


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

0ebc8dc3525ddaa04a0c9e4c0c1aef70fd3fe725
 testsuite/tests/simplCore/should_compile/Makefile  |  7 ++++++
 testsuite/tests/simplCore/should_compile/T14140.hs | 29 ++++++++++++++++++++++
 testsuite/tests/simplCore/should_compile/all.T     |  5 ++++
 3 files changed, 41 insertions(+)

diff --git a/testsuite/tests/simplCore/should_compile/Makefile b/testsuite/tests/simplCore/should_compile/Makefile
index f56a851..5790407 100644
--- a/testsuite/tests/simplCore/should_compile/Makefile
+++ b/testsuite/tests/simplCore/should_compile/Makefile
@@ -230,3 +230,10 @@ T11272:
 .PHONY: T12600
 T12600:
 	'$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-prep -dsuppress-all -dsuppress-uniques -dno-suppress-type-signatures -dppr-cols=200 T12600.hs | grep "wfoo" | head -n 1
+
+# We don't expect to case match on any literal numbers other than
+# 0 or 1. See T14140.hs for an explanation.
+T14140:
+	$(RM) -f T14140.o T14140.hi
+	-'$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl T14140.hs | grep '[2-9]# *->'
+# Expecting no output from the grep, hence "-"
diff --git a/testsuite/tests/simplCore/should_compile/T14140.hs b/testsuite/tests/simplCore/should_compile/T14140.hs
new file mode 100644
index 0000000..39476a2
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T14140.hs
@@ -0,0 +1,29 @@
+-- We don't want to see a case match on the result
+-- of dataToTag#. We check that by looking for case
+-- matches on any literal other than 0# or 1#. We
+-- only really expect to see 1# here (and not the tag
+-- for OtherOS), but just in case GHC decides to get
+-- clever with its knowledge of the possible results
+-- of (==#), we also permit 0#.
+{-# LANGUAGE MagicHash, BangPatterns #-}
+module T14140 where
+import GHC.Exts
+
+data OS = Linux | Windows | OSX        -- tier 1 desktop OSs
+        | FreeBSD | OpenBSD | NetBSD   -- other free Unix OSs
+        | DragonFly
+        | Solaris | AIX | HPUX | IRIX  -- ageing Unix OSs
+        | HaLVM                        -- bare metal / VMs / hypervisors
+        | Hurd                         -- GNU's microkernel
+        | IOS  | Android               -- mobile OSs
+        | Ghcjs
+        | OtherOS String
+
+-- This is similar to the derived Eq instance. We write it
+-- out manually to prevent future deriving changes from
+-- changing the test.
+instance Eq OS where
+  OtherOS x == OtherOS y = x == y
+  (!x) == (!y) = case dataToTag# x ==# dataToTag# y of
+               1# -> True
+               _ -> False
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index a692007..72b872a 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -274,3 +274,8 @@ test('T13708', normal, compile, [''])
 test('T14137', [ check_errmsg(r'thunk') ], compile, ['-dsuppress-uniques -ddump-simpl'])
 # bar and foo should CSEd here, so check for that in the Core
 test('T14186', [ only_ways(['optasm']), check_errmsg(r'bar = foo') ], compile, ['-ddump-simpl'])
+
+test('T14140',
+     normal,
+     run_command,
+     ['$MAKE -s --no-print-directory T14140'])