[commit: ghc] master: Fix #14608 by restoring an unboxed tuple check (ecff651)

[git at git.haskell.org]

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

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

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

commit ecff651fc2f6d9833131e3e7fbc9a37b5b2f84ee
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Tue Jan 2 16:03:08 2018 -0500

    Fix #14608 by restoring an unboxed tuple check
    
    Commit 714bebff44076061d0a719c4eda2cfd213b7ac3d removed
    a check in the bytecode compiler that caught illegal uses of unboxed
    tuples (and now sums) in case alternatives, which causes the program
    in #14608 to panic. This restores the check (using modern,
    levity-polymorphic vocabulary).
    
    Test Plan: make test TEST=T14608
    
    Reviewers: hvr, bgamari, dfeuer, simonpj
    
    Reviewed By: dfeuer, simonpj
    
    Subscribers: simonpj, rwbarton, thomie, carter
    
    GHC Trac Issues: #14608
    
    Differential Revision: https://phabricator.haskell.org/D4276


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

ecff651fc2f6d9833131e3e7fbc9a37b5b2f84ee
 compiler/ghci/ByteCodeGen.hs                   | 5 +++++
 testsuite/tests/ghci/should_fail/T14608.hs     | 7 +++++++
 testsuite/tests/ghci/should_fail/T14608.script | 1 +
 testsuite/tests/ghci/should_fail/T14608.stderr | 3 +++
 testsuite/tests/ghci/should_fail/all.T         | 1 +
 5 files changed, 17 insertions(+)

diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs
index 697dc63..d537080 100644
--- a/compiler/ghci/ByteCodeGen.hs
+++ b/compiler/ghci/ByteCodeGen.hs
@@ -962,6 +962,11 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
            | null real_bndrs = do
                 rhs_code <- schemeE d_alts s p_alts rhs
                 return (my_discr alt, rhs_code)
+           -- If an alt attempts to match on an unboxed tuple or sum, we must
+           -- bail out, as the bytecode compiler can't handle them.
+           -- (See Trac #14608.)
+           | any (\bndr -> typePrimRep (idType bndr) `lengthExceeds` 1) bndrs
+           = multiValException
            -- algebraic alt with some binders
            | otherwise =
              let (tot_wds, _ptrs_wds, args_offsets) =
diff --git a/testsuite/tests/ghci/should_fail/T14608.hs b/testsuite/tests/ghci/should_fail/T14608.hs
new file mode 100644
index 0000000..87d5617
--- /dev/null
+++ b/testsuite/tests/ghci/should_fail/T14608.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE UnboxedTuples #-}
+module T14608 where
+
+data UnboxedTupleData = MkUTD (# (),() #)
+
+doThings :: UnboxedTupleData -> ()
+doThings (MkUTD t) = ()
diff --git a/testsuite/tests/ghci/should_fail/T14608.script b/testsuite/tests/ghci/should_fail/T14608.script
new file mode 100644
index 0000000..c37a742
--- /dev/null
+++ b/testsuite/tests/ghci/should_fail/T14608.script
@@ -0,0 +1 @@
+:load T14608.hs
diff --git a/testsuite/tests/ghci/should_fail/T14608.stderr b/testsuite/tests/ghci/should_fail/T14608.stderr
new file mode 100644
index 0000000..fe84063
--- /dev/null
+++ b/testsuite/tests/ghci/should_fail/T14608.stderr
@@ -0,0 +1,3 @@
+Error: bytecode compiler can't handle unboxed tuples and sums.
+  Possibly due to foreign import/export decls in source.
+  Workaround: use -fobject-code, or compile this module to .o separately.
diff --git a/testsuite/tests/ghci/should_fail/all.T b/testsuite/tests/ghci/should_fail/all.T
index 58a396e..2851373 100644
--- a/testsuite/tests/ghci/should_fail/all.T
+++ b/testsuite/tests/ghci/should_fail/all.T
@@ -1,2 +1,3 @@
 test('T10549', [], ghci_script, ['T10549.script'])
 test('T10549a', [], ghci_script, ['T10549a.script'])
+test('T14608', [], ghci_script, ['T14608.script'])