[commit: ghc] master: Disallow standalone deriving declarations involving unboxed tuples or sums (23cf32d)

[git at git.haskell.org]

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

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

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

commit 23cf32da76fe6ed29fa141047749d390df763f94
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


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

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

diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs
index c47b00b..3fcc80d 100644
--- a/compiler/typecheck/TcDeriv.hs
+++ b/compiler/typecheck/TcDeriv.hs
@@ -591,12 +591,21 @@ deriveStandalone (L loc (DerivDecl deriv_ty deriv_strat' 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
@@ -604,8 +613,7 @@ deriveStandalone (L loc (DerivDecl deriv_ty deriv_strat' overlap_mode))
                     ; return [spec] }
 
            _  -> -- Complain about functions, primitive types, etc,
-                 failWithTc $ derivingThingErr False cls cls_tys
-                                               inst_ty deriv_strat $
+                 bale_out $
                  text "The last argument of the instance must be a data or newtype application"
         }
 
@@ -2672,3 +2680,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 aebfa9e..ce0cc0f 100644
--- a/testsuite/tests/deriving/should_fail/all.T
+++ b/testsuite/tests/deriving/should_fail/all.T
@@ -65,3 +65,4 @@ test('T10598_fail4', normal, compile_fail, [''])
 test('T10598_fail5', normal, compile_fail, [''])
 test('T10598_fail6', normal, compile_fail, [''])
 test('T12163', normal, compile_fail, [''])
+test('T12512', omit_ways(['ghci']), compile_fail, [''])