Commit c9532f81 authored by thomasw's avatar thomasw Committed by Austin Seipp
Browse files

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
parent 7637810a
......@@ -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] } }
......
{-# LANGUAGE DefaultSignatures #-}
module WildcardInDefaultSignature where
class C a where default f :: _
WildcardInDefaultSignature.hs:4:30:
Wildcard not allowed
in default signature: ‘_’
{-# LANGUAGE InstanceSigs #-}
module WildcardInInstanceSig where
instance Num Bool where negate :: _
WildcardInInstanceSig.hs:4:35:
Wildcard not allowed
in instance signature: ‘negate :: _’
{-# LANGUAGE StandaloneDeriving #-}
module WildcardInStandaloneDeriving where
deriving instance _
WildcardInStandaloneDeriving.hs:4:19:
Wildcard not allowed
in the stand-alone deriving instance: ‘_’
......@@ -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, [''])
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment