From 1b476ab55be6c2c553988cc63d8e0c5473136275 Mon Sep 17 00:00:00 2001 From: Simon Peyton Jones Date: Thu, 21 Sep 2017 17:39:18 +0100 Subject: [PATCH] Improve type-error reporting This patch does two things: * When reporting a hole, we now include its kind if the kind is not just '*'. This addresses Trac #14265 * When reporting things like "'a' is a rigid type varaible bound by ...", this patch arranges to group the type variables together, so we don't repeat the "bound by..." stuff endlessly --- compiler/typecheck/TcBinds.hs | 2 +- compiler/typecheck/TcErrors.hs | 86 ++++++++++++------- compiler/typecheck/TcRnTypes.hs | 6 +- testsuite/tests/ghci/scripts/T10248.stderr | 5 +- .../should_compile/SuperCls.stderr | 2 +- .../partial-sigs/should_compile/T10403.stderr | 25 ++---- .../partial-sigs/should_compile/T11016.stderr | 2 +- .../partial-sigs/should_compile/T11192.stderr | 10 +-- .../partial-sigs/should_compile/T12033.stderr | 12 +-- .../partial-sigs/should_compile/T12844.stderr | 21 +---- .../partial-sigs/should_compile/T12845.stderr | 2 +- .../WarningWildcardInstantiations.stderr | 5 +- .../partial-sigs/should_fail/T10045.stderr | 7 +- .../partial-sigs/should_fail/T12634.stderr | 2 +- .../should_fail/WildcardInstantiations.stderr | 5 +- testsuite/tests/perf/compiler/T13035.stderr | 2 +- testsuite/tests/polykinds/T14265.hs | 11 +++ testsuite/tests/polykinds/T14265.stderr | 24 ++++++ testsuite/tests/polykinds/all.T | 1 + 19 files changed, 129 insertions(+), 101 deletions(-) create mode 100644 testsuite/tests/polykinds/T14265.hs create mode 100644 testsuite/tests/polykinds/T14265.stderr diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs index ba73ab29ea..6a9b22a9bb 100644 --- a/compiler/typecheck/TcBinds.hs +++ b/compiler/typecheck/TcBinds.hs @@ -42,7 +42,7 @@ import TyCon import TcType import Type( mkStrLitTy, tidyOpenType, splitTyConApp_maybe) import TysPrim -import TysWiredIn( cTupleTyConName, mkBoxedTupleTy ) +import TysWiredIn( mkBoxedTupleTy ) import Id import Var import VarSet diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 795c3e5186..82bcb51c36 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -1083,9 +1083,10 @@ mkHoleError ctxt ct@(CHoleCan { cc_hole = hole }) valid_substitutions sub_msg} where - occ = holeOcc hole - hole_ty = ctEvPred (ctEvidence ct) - tyvars = tyCoVarsOfTypeList hole_ty + occ = holeOcc hole + hole_ty = ctEvPred (ctEvidence ct) + hole_kind = typeKind hole_ty + tyvars = tyCoVarsOfTypeList hole_ty hole_msg = case hole of ExprHole {} -> vcat [ hang (text "Found hole:") @@ -1094,11 +1095,21 @@ mkHoleError ctxt ct@(CHoleCan { cc_hole = hole }) TypeHole {} -> vcat [ hang (text "Found type wildcard" <+> quotes (ppr occ)) 2 (text "standing for" <+> - quotes (pprType hole_ty)) + quotes pp_hole_type_with_kind) , tyvars_msg, type_hole_hint ] + pp_hole_type_with_kind + | isLiftedTypeKind hole_kind = pprType hole_ty + | otherwise = pprType hole_ty <+> dcolon <+> pprKind hole_kind + tyvars_msg = ppUnless (null tyvars) $ - text "Where:" <+> vcat (map loc_msg tyvars) + text "Where:" <+> (vcat (map loc_msg other_tvs) + $$ pprSkols ctxt skol_tvs) + where + (skol_tvs, other_tvs) = partition is_skol tyvars + is_skol tv = isTcTyVar tv && isSkolemTyVar tv + -- Coercion variables can be free in the + -- hole, via kind casts type_hole_hint | HoleError <- cec_type_holes ctxt @@ -1117,8 +1128,8 @@ mkHoleError ctxt ct@(CHoleCan { cc_hole = hole }) | isTyVar tv = case tcTyVarDetails tv of MetaTv {} -> quotes (ppr tv) <+> text "is an ambiguous type variable" - _ -> extraTyVarInfo ctxt tv - | otherwise + _ -> empty -- Skolems dealt with already + | otherwise -- A coercion variable can be free in the hole type = sdocWithDynFlags $ \dflags -> if gopt Opt_PrintExplicitCoercions dflags then quotes (ppr tv) <+> text "is a coercion variable" @@ -1886,12 +1897,9 @@ extraTyVarInfo :: ReportErrCtxt -> TcTyVar -> SDoc extraTyVarInfo ctxt tv = ASSERT2( isTyVar tv, ppr tv ) case tcTyVarDetails tv of - SkolemTv {} -> pprSkol implics tv - RuntimeUnk {} -> pp_tv <+> text "is an interactive-debugger skolem" + SkolemTv {} -> pprSkols ctxt [tv] + RuntimeUnk {} -> quotes (ppr tv) <+> text "is an interactive-debugger skolem" MetaTv {} -> empty - where - implics = cec_encl ctxt - pp_tv = quotes (ppr tv) suggestAddSig :: ReportErrCtxt -> TcType -> TcType -> SDoc -- See Note [Suggest adding a type signature] @@ -1906,7 +1914,8 @@ suggestAddSig ctxt ty1 ty2 inferred_bndrs = nub (get_inf ty1 ++ get_inf ty2) get_inf ty | Just tv <- tcGetTyVar_maybe ty , isSkolemTyVar tv - , InferSkol prs <- ic_info (getSkolemInfo (cec_encl ctxt) tv) + , (implic, _) : _ <- getSkolemInfo (cec_encl ctxt) [tv] + , InferSkol prs <- ic_info implic = map fst prs | otherwise = [] @@ -2846,17 +2855,24 @@ mkAmbigMsg prepend_msg ct is_or_are [_] = text "is" is_or_are _ = text "are" -pprSkol :: [Implication] -> TcTyVar -> SDoc -pprSkol implics tv - = case skol_info of - UnkSkol -> quotes (ppr tv) <+> text "is an unknown type variable" - _ -> ppr_rigid (pprSkolInfo skol_info) +pprSkols :: ReportErrCtxt -> [TcTyVar] -> SDoc +pprSkols ctxt tvs + = vcat (map pp_one (getSkolemInfo (cec_encl ctxt) tvs)) where - Implic { ic_info = skol_info } = getSkolemInfo implics tv - ppr_rigid pp_info - = hang (quotes (ppr tv) <+> text "is a rigid type variable bound by") - 2 (sep [ pp_info - , text "at" <+> ppr (getSrcSpan tv) ]) + pp_one (Implic { ic_info = skol_info }, tvs) + | UnkSkol <- skol_info + = hang (pprQuotedList tvs) + 2 (is_or_are tvs "an" "unknown") + | otherwise + = vcat [ hang (pprQuotedList tvs) + 2 (is_or_are tvs "a" "rigid" <+> text "bound by") + , nest 2 (pprSkolInfo skol_info) + , nest 2 (text "at" <+> ppr (foldr1 combineSrcSpans (map getSrcSpan tvs))) ] + + is_or_are [_] article adjective = text "is" <+> text article <+> text adjective + <+> text "type variable" + is_or_are _ _ adjective = text "are" <+> text adjective + <+> text "type variables" getAmbigTkvs :: Ct -> ([Var],[Var]) getAmbigTkvs ct @@ -2866,15 +2882,23 @@ getAmbigTkvs ct ambig_tkvs = filter isAmbiguousTyVar tkvs dep_tkv_set = tyCoVarsOfTypes (map tyVarKind tkvs) -getSkolemInfo :: [Implication] -> TcTyVar -> Implication --- Get the skolem info for a type variable --- from the implication constraint that binds it -getSkolemInfo [] tv - = pprPanic "No skolem info:" (ppr tv) +getSkolemInfo :: [Implication] -> [TcTyVar] + -> [(Implication, [TcTyVar])] +-- Get the skolem info for some type variables +-- from the implication constraints that bind them +-- +-- In the returned (implic, tvs) pairs, the 'tvs' part is non-empty +getSkolemInfo _ [] + = [] + +getSkolemInfo [] tvs + = pprPanic "No skolem info:" (ppr tvs) -getSkolemInfo (implic:implics) tv - | tv `elem` ic_skols implic = implic - | otherwise = getSkolemInfo implics tv +getSkolemInfo (implic:implics) tvs + | null tvs_here = getSkolemInfo implics tvs + | otherwise = (implic, tvs_here) : getSkolemInfo implics tvs_other + where + (tvs_here, tvs_other) = partition (`elem` ic_skols implic) tvs ----------------------- -- relevantBindings looks at the value environment and finds values whose diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index 4c708dd8a2..c581a88768 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -3113,9 +3113,9 @@ pprSkolInfo (RuleSkol name) = text "the RULE" <+> pprRuleName name pprSkolInfo ArrowSkol = text "an arrow form" pprSkolInfo (PatSkol cl mc) = sep [ pprPatSkolInfo cl , text "in" <+> pprMatchContext mc ] -pprSkolInfo (InferSkol ids) = sep [ text "the inferred type of" - , vcat [ ppr name <+> dcolon <+> ppr ty - | (name,ty) <- ids ]] +pprSkolInfo (InferSkol ids) = hang (text "the inferred type" <> plural ids <+> text "of") + 2 (vcat [ ppr name <+> dcolon <+> ppr ty + | (name,ty) <- ids ]) pprSkolInfo (UnifyForAllSkol ty) = text "the type" <+> ppr ty -- UnkSkol diff --git a/testsuite/tests/ghci/scripts/T10248.stderr b/testsuite/tests/ghci/scripts/T10248.stderr index e1ca96c63f..283ccdddc4 100644 --- a/testsuite/tests/ghci/scripts/T10248.stderr +++ b/testsuite/tests/ghci/scripts/T10248.stderr @@ -1,10 +1,7 @@ :2:10: error: • Found hole: _ :: f a - Where: ‘f’ is a rigid type variable bound by - the inferred type of it :: Functor f => f (Maybe a) - at :2:1-10 - ‘a’ is a rigid type variable bound by + Where: ‘f’, ‘a’ are rigid type variables bound by the inferred type of it :: Functor f => f (Maybe a) at :2:1-10 • In the second argument of ‘(<$>)’, namely ‘_’ diff --git a/testsuite/tests/partial-sigs/should_compile/SuperCls.stderr b/testsuite/tests/partial-sigs/should_compile/SuperCls.stderr index 01651a4136..a11164482c 100644 --- a/testsuite/tests/partial-sigs/should_compile/SuperCls.stderr +++ b/testsuite/tests/partial-sigs/should_compile/SuperCls.stderr @@ -1,4 +1,4 @@ SuperCls.hs:4:14: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘() :: Constraint’ + • Found type wildcard ‘_’ standing for ‘()’ • In the type signature: f :: (Ord a, _) => a -> Bool diff --git a/testsuite/tests/partial-sigs/should_compile/T10403.stderr b/testsuite/tests/partial-sigs/should_compile/T10403.stderr index 6ebd844bff..229b9e1df1 100644 --- a/testsuite/tests/partial-sigs/should_compile/T10403.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T10403.stderr @@ -1,33 +1,26 @@ T10403.hs:15:7: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘Functor f’ - Where: ‘f’ is a rigid type variable bound by - the inferred type of h1 :: Functor f => (a -> b) -> f a -> H f + Where: ‘f’ is a rigid type variable + bound by the inferred type of + h1 :: Functor f => (a -> b) -> f a -> H f at T10403.hs:17:1-41 • In the type signature: h1 :: _ => _ T10403.hs:15:12: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘(a -> b) -> f a -> H f’ - Where: ‘b’ is a rigid type variable bound by - the inferred type of h1 :: Functor f => (a -> b) -> f a -> H f - at T10403.hs:17:1-41 - ‘a’ is a rigid type variable bound by - the inferred type of h1 :: Functor f => (a -> b) -> f a -> H f - at T10403.hs:17:1-41 - ‘f’ is a rigid type variable bound by - the inferred type of h1 :: Functor f => (a -> b) -> f a -> H f + Where: ‘b’, ‘a’, ‘f’ are rigid type variables + bound by the inferred type of + h1 :: Functor f => (a -> b) -> f a -> H f at T10403.hs:17:1-41 • In the type signature: h1 :: _ => _ T10403.hs:19:7: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘(a -> b) -> f0 a -> H f0’ - Where: ‘b’ is a rigid type variable bound by - the inferred type of h2 :: (a -> b) -> f0 a -> H f0 - at T10403.hs:22:1-41 - ‘a’ is a rigid type variable bound by - the inferred type of h2 :: (a -> b) -> f0 a -> H f0 + Where: ‘f0’ is an ambiguous type variable + ‘b’, ‘a’ are rigid type variables + bound by the inferred type of h2 :: (a -> b) -> f0 a -> H f0 at T10403.hs:22:1-41 - ‘f0’ is an ambiguous type variable • In the type signature: h2 :: _ T10403.hs:22:15: warning: [-Wdeferred-type-errors (in -Wdefault)] diff --git a/testsuite/tests/partial-sigs/should_compile/T11016.stderr b/testsuite/tests/partial-sigs/should_compile/T11016.stderr index 343deabe86..49363fb24c 100644 --- a/testsuite/tests/partial-sigs/should_compile/T11016.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T11016.stderr @@ -1,6 +1,6 @@ T11016.hs:5:19: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘() :: Constraint’ + • Found type wildcard ‘_’ standing for ‘()’ • In the type signature: f1 :: (?x :: Int, _) => Int T11016.hs:8:22: warning: [-Wpartial-type-signatures (in -Wdefault)] diff --git a/testsuite/tests/partial-sigs/should_compile/T11192.stderr b/testsuite/tests/partial-sigs/should_compile/T11192.stderr index 0f2d2e09b6..8030276206 100644 --- a/testsuite/tests/partial-sigs/should_compile/T11192.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T11192.stderr @@ -2,7 +2,8 @@ T11192.hs:7:14: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘Int -> p -> p’ Where: ‘p’ is a rigid type variable bound by - the inferred type of go :: Int -> p -> p at T11192.hs:8:8-17 + the inferred type of go :: Int -> p -> p + at T11192.hs:8:8-17 • In the type signature: go :: _ In the expression: let @@ -19,10 +20,9 @@ T11192.hs:7:14: warning: [-Wpartial-type-signatures (in -Wdefault)] T11192.hs:13:14: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘p -> p1 -> p1’ - Where: ‘p’ is a rigid type variable bound by - the inferred type of go :: p -> p1 -> p1 at T11192.hs:14:8-17 - ‘p1’ is a rigid type variable bound by - the inferred type of go :: p -> p1 -> p1 at T11192.hs:14:8-17 + Where: ‘p’, ‘p1’ are rigid type variables bound by + the inferred type of go :: p -> p1 -> p1 + at T11192.hs:14:8-17 • In the type signature: go :: _ In the expression: let diff --git a/testsuite/tests/partial-sigs/should_compile/T12033.stderr b/testsuite/tests/partial-sigs/should_compile/T12033.stderr index a3b293b0cc..780fb9d41b 100644 --- a/testsuite/tests/partial-sigs/should_compile/T12033.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T12033.stderr @@ -1,15 +1,15 @@ T12033.hs:12:22: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘v -> t’ - Where: ‘v’ is a rigid type variable bound by + Where: ‘t’ is a rigid type variable bound by + the inferred types of + makeTuple :: v -> t + makeExpression :: v -> t + at T12033.hs:(11,4)-(13,39) + ‘v’ is a rigid type variable bound by the type signature for: tripleStoreToRuleSet :: forall v. v -> v at T12033.hs:6:1-30 - ‘t’ is a rigid type variable bound by - the inferred type of - makeTuple :: v -> t - makeExpression :: v -> t - at T12033.hs:(11,4)-(13,39) • In the type signature: makeExpression :: _ In an equation for ‘tripleStoreToRuleSet’: tripleStoreToRuleSet getAtom diff --git a/testsuite/tests/partial-sigs/should_compile/T12844.stderr b/testsuite/tests/partial-sigs/should_compile/T12844.stderr index 8ad3777f2a..3846590890 100644 --- a/testsuite/tests/partial-sigs/should_compile/T12844.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T12844.stderr @@ -2,24 +2,9 @@ T12844.hs:12:9: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘(Head rngs ~ '(r, r'), Foo rngs)’ - Where: ‘r’ is a rigid type variable bound by + Where: ‘r’, ‘r'’, ‘rngs’, ‘k’, ‘k1’ + are rigid type variables bound by the inferred type of - bar :: (Head rngs ~ '(r, r'), Foo rngs) => FooData rngs - at T12844.hs:13:1-9 - ‘r'’ is a rigid type variable bound by - the inferred type of - bar :: (Head rngs ~ '(r, r'), Foo rngs) => FooData rngs - at T12844.hs:13:1-9 - ‘rngs’ is a rigid type variable bound by - the inferred type of - bar :: (Head rngs ~ '(r, r'), Foo rngs) => FooData rngs - at T12844.hs:13:1-9 - ‘k’ is a rigid type variable bound by - the inferred type of - bar :: (Head rngs ~ '(r, r'), Foo rngs) => FooData rngs - at T12844.hs:13:1-9 - ‘k1’ is a rigid type variable bound by - the inferred type of - bar :: (Head rngs ~ '(r, r'), Foo rngs) => FooData rngs + bar :: (Head rngs ~ '(r, r'), Foo rngs) => FooData rngs at T12844.hs:13:1-9 • In the type signature: bar :: _ => FooData rngs diff --git a/testsuite/tests/partial-sigs/should_compile/T12845.stderr b/testsuite/tests/partial-sigs/should_compile/T12845.stderr index b9d7d60a97..a483c84231 100644 --- a/testsuite/tests/partial-sigs/should_compile/T12845.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T12845.stderr @@ -1,6 +1,6 @@ T12845.hs:18:70: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘() :: Constraint’ + • Found type wildcard ‘_’ standing for ‘()’ • In the type signature: broken :: forall r r' rngs. ('(r, r') ~ Head rngs, Bar r r' ~ 'True, _) => diff --git a/testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr b/testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr index ca815439de..560b74d3b9 100644 --- a/testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr +++ b/testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr @@ -34,10 +34,7 @@ WarningWildcardInstantiations.hs:8:8: warning: [-Wpartial-type-signatures (in -W WarningWildcardInstantiations.hs:8:13: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘t -> w’ - Where: ‘t’ is a rigid type variable bound by - the inferred type of bar :: t -> (t -> w) -> w - at WarningWildcardInstantiations.hs:9:1-13 - ‘w’ is a rigid type variable bound by + Where: ‘t’, ‘w’ are rigid type variables bound by the inferred type of bar :: t -> (t -> w) -> w at WarningWildcardInstantiations.hs:9:1-13 • In the type signature: bar :: _ -> _ -> _ diff --git a/testsuite/tests/partial-sigs/should_fail/T10045.stderr b/testsuite/tests/partial-sigs/should_fail/T10045.stderr index a18ef48b83..e6f6462d5d 100644 --- a/testsuite/tests/partial-sigs/should_fail/T10045.stderr +++ b/testsuite/tests/partial-sigs/should_fail/T10045.stderr @@ -1,10 +1,9 @@ T10045.hs:6:18: error: • Found type wildcard ‘_’ standing for ‘t1 -> Bool -> t2’ - Where: ‘t1’ is a rigid type variable bound by - the inferred type of copy :: t1 -> Bool -> t2 at T10045.hs:7:10-34 - ‘t2’ is a rigid type variable bound by - the inferred type of copy :: t1 -> Bool -> t2 at T10045.hs:7:10-34 + Where: ‘t1’, ‘t2’ are rigid type variables bound by + the inferred type of copy :: t1 -> Bool -> t2 + at T10045.hs:7:10-34 To use the inferred type, enable PartialTypeSignatures • In the type signature: copy :: _ In the expression: diff --git a/testsuite/tests/partial-sigs/should_fail/T12634.stderr b/testsuite/tests/partial-sigs/should_fail/T12634.stderr index 7f1d713c4f..dd661a9355 100644 --- a/testsuite/tests/partial-sigs/should_fail/T12634.stderr +++ b/testsuite/tests/partial-sigs/should_fail/T12634.stderr @@ -1,6 +1,6 @@ T12634.hs:14:37: error: - • Found type wildcard ‘_’ standing for ‘() :: Constraint’ + • Found type wildcard ‘_’ standing for ‘()’ To use the inferred type, enable PartialTypeSignatures • In the type signature: bench_twacePow :: forall t m m' r. diff --git a/testsuite/tests/partial-sigs/should_fail/WildcardInstantiations.stderr b/testsuite/tests/partial-sigs/should_fail/WildcardInstantiations.stderr index 440d8722de..aa5e8247f3 100644 --- a/testsuite/tests/partial-sigs/should_fail/WildcardInstantiations.stderr +++ b/testsuite/tests/partial-sigs/should_fail/WildcardInstantiations.stderr @@ -30,10 +30,7 @@ WildcardInstantiations.hs:8:8: error: WildcardInstantiations.hs:8:13: error: • Found type wildcard ‘_’ standing for ‘t -> w’ - Where: ‘t’ is a rigid type variable bound by - the inferred type of bar :: t -> (t -> w) -> w - at WildcardInstantiations.hs:9:1-13 - ‘w’ is a rigid type variable bound by + Where: ‘t’, ‘w’ are rigid type variables bound by the inferred type of bar :: t -> (t -> w) -> w at WildcardInstantiations.hs:9:1-13 To use the inferred type, enable PartialTypeSignatures diff --git a/testsuite/tests/perf/compiler/T13035.stderr b/testsuite/tests/perf/compiler/T13035.stderr index 52836d7e3c..fe1f0b2564 100644 --- a/testsuite/tests/perf/compiler/T13035.stderr +++ b/testsuite/tests/perf/compiler/T13035.stderr @@ -1,4 +1,4 @@ T13035.hs:141:28: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘'['Author]’ + • Found type wildcard ‘_’ standing for ‘'['Author] :: [Fields]’ • In the type signature: g :: MyRec RecipeFormatter _ diff --git a/testsuite/tests/polykinds/T14265.hs b/testsuite/tests/polykinds/T14265.hs new file mode 100644 index 0000000000..84c1a025a1 --- /dev/null +++ b/testsuite/tests/polykinds/T14265.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE PolyKinds #-} + +module T124265 where + +import Control.Monad.Trans.State( StateT ) + +f :: proxy _ -> () +f _ = () + +foo :: StateT _ _ () +foo = undefined diff --git a/testsuite/tests/polykinds/T14265.stderr b/testsuite/tests/polykinds/T14265.stderr new file mode 100644 index 0000000000..be6868fdc4 --- /dev/null +++ b/testsuite/tests/polykinds/T14265.stderr @@ -0,0 +1,24 @@ + +T14265.hs:7:12: error: + • Found type wildcard ‘_’ standing for ‘w :: k’ + Where: ‘w’, ‘k’ are rigid type variables bound by + the inferred type of f :: proxy w -> () + at T14265.hs:8:1-8 + To use the inferred type, enable PartialTypeSignatures + • In the type signature: f :: proxy _ -> () + +T14265.hs:10:15: error: + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of foo :: StateT w w1 () + at T14265.hs:11:1-15 + To use the inferred type, enable PartialTypeSignatures + • In the type signature: foo :: StateT _ _ () + +T14265.hs:10:17: error: + • Found type wildcard ‘_’ standing for ‘w1 :: * -> *’ + Where: ‘w1’ is a rigid type variable bound by + the inferred type of foo :: StateT w w1 () + at T14265.hs:11:1-15 + To use the inferred type, enable PartialTypeSignatures + • In the type signature: foo :: StateT _ _ () diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index c01b73c98d..78c16975da 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -168,3 +168,4 @@ test('T14110', normal, compile_fail, ['']) test('BadKindVar', normal, compile_fail, ['']) test('T13738', normal, compile_fail, ['']) test('T14209', normal, compile, ['']) +test('T14265', normal, compile_fail, ['']) -- GitLab