[commit: ghc] ghc-8.0: Disallow standalone deriving declarations involving unboxed tuples or sums (c448d55)

[git at git.haskell.org]

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

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/c448d5513d68da7077b2b4d3adadda93120d8504/ghc

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

commit c448d5513d68da7077b2b4d3adadda93120d8504
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Sat Oct 1 17:58:44 2016 -0400

    Disallow standalone deriving declarations involving unboxed tuples or sums
    
    There was an awful leak where GHC permitted standalone `deriving`
    declarations to create instances for unboxed sum or tuple types. This
    fortifies the checks that GHC performs to catch this scenario and give
    an appropriate error message.
    
    Fixes #11509.
    
    Test Plan: ./validate
    
    Reviewers: goldfire, austin, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D2557
    
    GHC Trac Issues: #11509
    
    (cherry picked from commit 23cf32da76fe6ed29fa141047749d390df763f94)


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

c448d5513d68da7077b2b4d3adadda93120d8504
 compiler/typecheck/TcDeriv.hs                      | 15 ++++++++++++++-
 testsuite/tests/deriving/should_fail/T12512.hs     | 14 ++++++++++++++
 testsuite/tests/deriving/should_fail/T12512.stderr | 10 ++++++++++
 testsuite/tests/deriving/should_fail/all.T         |  2 +-
 4 files changed, 39 insertions(+), 2 deletions(-)

diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs
index f4069b5..113890a 100644
--- a/compiler/typecheck/TcDeriv.hs
+++ b/compiler/typecheck/TcDeriv.hs
@@ -583,12 +583,21 @@ deriveStandalone (L loc (DerivDecl deriv_ty overlap_mode))
               , text "class types:" <+> ppr cls_tys
               , text "type:" <+> ppr inst_ty ]
 
+       ; let bale_out msg = failWithTc (derivingThingErr False cls cls_tys
+                              inst_ty deriv_strat msg)
+
        ; case tcSplitTyConApp_maybe inst_ty of
            Just (tc, tc_args)
               | className cls == typeableClassName
               -> do warnUselessTypeable
                     return []
 
+              | isUnboxedTupleTyCon tc
+              -> bale_out $ unboxedTyConErr "tuple"
+
+              | isUnboxedSumTyCon tc
+              -> bale_out $ unboxedTyConErr "sum"
+
               | isAlgTyCon tc || isDataFamilyTyCon tc  -- All other classes
               -> do { spec <- mkEqnHelp (fmap unLoc overlap_mode)
                                         tvs cls cls_tys tc tc_args
@@ -596,7 +605,7 @@ deriveStandalone (L loc (DerivDecl deriv_ty overlap_mode))
                     ; return [spec] }
 
            _  -> -- Complain about functions, primitive types, etc,
-                 failWithTc $ derivingThingErr False cls cls_tys inst_ty $
+                 bale_out $
                  text "The last argument of the instance must be a data or newtype application"
         }
 
@@ -2438,3 +2447,7 @@ standaloneCtxt ty = hang (text "In the stand-alone deriving instance for")
 derivInstCtxt :: PredType -> MsgDoc
 derivInstCtxt pred
   = text "When deriving the instance for" <+> parens (ppr pred)
+
+unboxedTyConErr :: String -> MsgDoc
+unboxedTyConErr thing =
+  text "The last argument of the instance cannot be an unboxed" <+> text thing
diff --git a/testsuite/tests/deriving/should_fail/T12512.hs b/testsuite/tests/deriving/should_fail/T12512.hs
new file mode 100644
index 0000000..87c3d66
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T12512.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE UnboxedSums #-}
+{-# LANGUAGE UnboxedTuples #-}
+module T12512 where
+
+import GHC.Exts
+
+class Wat1 (a :: TYPE 'UnboxedTupleRep)
+deriving instance Wat1 (# a, b #)
+
+class Wat2 (a :: TYPE 'UnboxedSumRep)
+deriving instance Wat2 (# a | b #)
diff --git a/testsuite/tests/deriving/should_fail/T12512.stderr b/testsuite/tests/deriving/should_fail/T12512.stderr
new file mode 100644
index 0000000..48f0eae
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T12512.stderr
@@ -0,0 +1,10 @@
+
+T12512.hs:11:1: error:
+    • Can't make a derived instance of ‘Wat1 (# a, b #)’:
+        The last argument of the instance cannot be an unboxed tuple
+    • In the stand-alone deriving instance for ‘Wat1 (# a, b #)’
+
+T12512.hs:14:1: error:
+    • Can't make a derived instance of ‘Wat2 (# a | b #)’:
+        The last argument of the instance cannot be an unboxed sum
+    • In the stand-alone deriving instance for ‘Wat2 (# a | b #)’
diff --git a/testsuite/tests/deriving/should_fail/all.T b/testsuite/tests/deriving/should_fail/all.T
index e0c6e62..cca26bf 100644
--- a/testsuite/tests/deriving/should_fail/all.T
+++ b/testsuite/tests/deriving/should_fail/all.T
@@ -58,4 +58,4 @@ test('T9687', normal, compile_fail, [''])
 
 test('T8984', normal, compile_fail, [''])
 test('T9968a', normal, compile_fail, [''])
-
+test('T12512', omit_ways(['ghci']), compile_fail, [''])