Fix panics of PartialTypeSignatures combined with extensions

Summary:
Disallow wildcards in stand-alone deriving instances
(StandaloneDeriving), default signatures (DefaultSignatures) and
instances signatures (InstanceSigs).

Test Plan: validate

Reviewers: austin

Reviewed By: austin

Subscribers: carter, thomie, monoidal

Differential Revision: https://phabricator.haskell.org/D595

GHC Trac Issues: #9922

(cherry picked from commit c9532f81)

compiler/parser/Parser.y

@@ -798,6 +798,10 @@ inst_decl :: { LInstDecl RdrName }
                                      , cid_datafam_insts = adts }
              ; let err = text "In instance head:" <+> ppr $3
              ; checkNoPartialType err $3
+             ; sequence_ [ checkNoPartialType err ty
+                         | sig@(L _ (TypeSig _ ty _ )) <- sigs
+                         , let err = text "in instance signature" <> colon
+                                     <+> quotes (ppr sig) ]
              ; ams (L (comb3 $1 $3 $4) (ClsInstD { cid_inst = cid }))
                    (mj AnnInstance $1 : (fst $ unLoc $4)) } }
 
@@ -972,8 +976,12 @@ capi_ctype : '{-# CTYPE' STRING STRING '#-}'
 -- Glasgow extension: stand-alone deriving declarations
 stand_alone_deriving :: { LDerivDecl RdrName }
   : 'deriving' 'instance' overlap_pragma inst_type
-                         {% ams (sLL $1 $> (DerivDecl $4 $3))
-                                [mj AnnDeriving $1,mj AnnInstance $2] }
+                         {% do {
+                                 let err = text "in the stand-alone deriving instance"
+                                            <> colon <+> quotes (ppr $4)
+                               ; checkNoPartialType err $4
+                               ; ams (sLL $1 $> (DerivDecl $4 $3))
+                                     [mj AnnDeriving $1,mj AnnInstance $2] }}
 
 -----------------------------------------------------------------------------
 -- Role annotations
@@ -1070,6 +1078,9 @@ decl_cls  : at_decl_cls                 { sLL $1 $> (unitOL $1) }
           -- A 'default' signature used with the generic-programming extension
           | 'default' infixexp '::' sigtypedoc
                     {% do { (TypeSig l ty _) <- checkValSig $2 $4
+                          ; let err = text "in default signature" <> colon <+>
+                                      quotes (ppr ty)
+                          ; checkNoPartialType err ty
                           ; ams (sLL $1 $> $ unitOL (sLL $1 $> $ SigD (GenericSig l ty)))
                                 [mj AnnDefault $1,mj AnnDcolon $3] } }
 

testsuite/tests/partial-sigs/should_fail/WildcardInDefaultSignature.hs

+{-# LANGUAGE DefaultSignatures #-}
+module WildcardInDefaultSignature where
+
+class C a where default f :: _

testsuite/tests/partial-sigs/should_fail/WildcardInDefaultSignature.stderr

+
+WildcardInDefaultSignature.hs:4:30:
+    Wildcard not allowed
+    in default signature: ‘_’

testsuite/tests/partial-sigs/should_fail/WildcardInInstanceSig.hs

+{-# LANGUAGE InstanceSigs #-}
+module WildcardInInstanceSig where
+
+instance Num Bool where negate :: _

testsuite/tests/partial-sigs/should_fail/WildcardInInstanceSig.stderr

+
+WildcardInInstanceSig.hs:4:35:
+    Wildcard not allowed
+    in instance signature: ‘negate :: _’

testsuite/tests/partial-sigs/should_fail/WildcardInStandaloneDeriving.hs

+{-# LANGUAGE StandaloneDeriving #-}
+module WildcardInStandaloneDeriving where
+
+deriving instance _

testsuite/tests/partial-sigs/should_fail/WildcardInStandaloneDeriving.stderr

+
+WildcardInStandaloneDeriving.hs:4:19:
+    Wildcard not allowed
+    in the stand-alone deriving instance: ‘_’

testsuite/tests/partial-sigs/should_fail/all.T

@@ -26,15 +26,18 @@ test('WildcardInADT3', normal, compile_fail, [''])
 test('WildcardInADTContext1', normal, compile_fail, [''])
 test('WildcardInADTContext2', normal, compile_fail, [''])
 test('WildcardInDefault', normal, compile_fail, [''])
+test('WildcardInDefaultSignature', normal, compile_fail, [''])
 test('WildcardInDeriving', normal, compile_fail, [''])
 test('WildcardInForeignExport', normal, compile_fail, [''])
 test('WildcardInForeignImport', normal, compile_fail, [''])
 test('WildcardInGADT1', normal, compile_fail, [''])
 test('WildcardInGADT2', normal, compile_fail, [''])
 test('WildcardInInstanceHead', normal, compile_fail, [''])
+test('WildcardInInstanceSig', normal, compile_fail, [''])
 test('WildcardsInPatternAndExprSig', normal, compile_fail, [''])
 test('WildcardInPatSynSig', normal, compile_fail, [''])
 test('WildcardInNewtype', normal, compile_fail, [''])
+test('WildcardInStandaloneDeriving', normal, compile_fail, [''])
 test('WildcardInstantiations', normal, compile_fail, [''])
 test('WildcardInTypeBrackets', [req_interp, only_compiler_types(['ghc'])], compile_fail, [''])
 test('WildcardInTypeFamilyInstanceLHS', normal, compile_fail, [''])