diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2022-05-04 11:33:33 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-05-04 16:15:34 -0400 |
commit | 934a90dd6a34d2d1100506795d5f76cd20e2c599 (patch) | |
tree | 561c17ba9967acec60db33c2f050c87a3c183848 | |
parent | d61f742876bdf2cd32e76f7bca389106ad99a316 (diff) | |
download | haskell-934a90dd6a34d2d1100506795d5f76cd20e2c599.tar.gz |
Improve error reporting in generated code
Our error reporting in generated code (via desugaring before
typechecking) only worked when the generated code was just a simple
call. This commit makes it work in nested cases.
-rw-r--r-- | compiler/GHC/Rename/Utils.hs | 12 | ||||
-rw-r--r-- | compiler/GHC/Tc/Errors/Ppr.hs | 69 | ||||
-rw-r--r-- | compiler/GHC/Tc/Gen/App.hs | 44 | ||||
-rw-r--r-- | compiler/GHC/Tc/Gen/Head.hs | 28 | ||||
-rw-r--r-- | compiler/GHC/Tc/Types.hs | 5 | ||||
-rw-r--r-- | compiler/GHC/Tc/Types.hs-boot | 3 | ||||
-rw-r--r-- | testsuite/tests/dependent/should_fail/T15859.stderr | 3 | ||||
-rw-r--r-- | testsuite/tests/dependent/should_fail/T15859a.stderr | 4 | ||||
-rw-r--r-- | testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr | 12 | ||||
-rw-r--r-- | testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr | 1 | ||||
-rw-r--r-- | testsuite/tests/parser/should_fail/T20654a.stderr | 3 | ||||
-rw-r--r-- | testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr | 4 | ||||
-rw-r--r-- | testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInExpressionSignature.stderr | 4 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_compile/T14590.stderr | 6 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_fail/tcfail104.stderr | 12 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_fail/tcfail140.stderr | 2 |
16 files changed, 126 insertions, 86 deletions
diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs index 597af3d778..be0b12a278 100644 --- a/compiler/GHC/Rename/Utils.hs +++ b/compiler/GHC/Rename/Utils.hs @@ -20,7 +20,7 @@ module GHC.Rename.Utils ( mkFieldEnv, badQualBndrErr, typeAppErr, badFieldConErr, wrapGenSpan, genHsVar, genLHsVar, genHsApp, genHsApps, genAppType, - genHsIntegralLit, genHsTyLit, + genHsIntegralLit, genHsTyLit, genSimpleConPat, newLocalBndrRn, newLocalBndrsRn, @@ -676,3 +676,13 @@ genHsIntegralLit lit = wrapGenSpan $ HsLit noAnn (HsInt noExtField lit) genHsTyLit :: FastString -> HsType GhcRn genHsTyLit = HsTyLit noExtField . HsStrTy NoSourceText + +genSimpleConPat :: Name -> [Name] -> LPat GhcRn +-- The pattern (C x1 .. xn) +genSimpleConPat con args + = wrapGenSpan $ ConPat { pat_con_ext = noExtField + , pat_con = wrapGenSpan con + , pat_args = PrefixCon [] (map genVarPat args) } + +genVarPat :: Name -> LPat GhcRn +genVarPat n = wrapGenSpan $ VarPat noExtField (wrapGenSpan n) diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs index 86aac8d99d..e8cf8ce097 100644 --- a/compiler/GHC/Tc/Errors/Ppr.hs +++ b/compiler/GHC/Tc/Errors/Ppr.hs @@ -46,7 +46,7 @@ import GHC.Hs import GHC.Tc.Errors.Types import GHC.Tc.Types.Constraint -import {-# SOURCE #-} GHC.Tc.Types (getLclEnvLoc) +import {-# SOURCE #-} GHC.Tc.Types( getLclEnvLoc, lclEnvInGeneratedCode ) import GHC.Tc.Types.Origin import GHC.Tc.Types.Rank (Rank(..)) import GHC.Tc.Utils.TcType @@ -1913,7 +1913,7 @@ pprTcSolverReportMsg _ , mismatch_item = item , mismatch_ty1 = ty1 , mismatch_ty2 = ty2 }) - = addArising (errorItemOrigin item) msg + = addArising (errorItemCtLoc item) msg where msg | (isLiftedRuntimeRep ty1 && isUnliftedRuntimeRep ty2) || @@ -1979,7 +1979,7 @@ pprTcSolverReportMsg ctxt , teq_mismatch_expected = exp , teq_mismatch_actual = act , teq_mismatch_what = mb_thing }) - = addArising orig $ pprWithExplicitKindsWhen ppr_explicit_kinds msg + = addArising ct_loc $ pprWithExplicitKindsWhen ppr_explicit_kinds msg where msg | isUnliftedTypeKind act, isLiftedTypeKind exp @@ -2155,7 +2155,7 @@ pprTcSolverReportMsg _ (ExpectingMoreArguments n thing) = pprTcSolverReportMsg ctxt (UnboundImplicitParams (item :| items)) = let givens = getUserGivens ctxt in if null givens - then addArising (errorItemOrigin item) $ + then addArising (errorItemCtLoc item) $ sep [ text "Unbound implicit parameter" <> plural preds , nest 2 (pprParendTheta preds) ] else pprTcSolverReportMsg ctxt (CouldNotDeduce givens (item :| items) Nothing) @@ -2171,9 +2171,9 @@ pprTcSolverReportMsg ctxt (CouldNotDeduce useful_givens (item :| others) mb_extr where main_msg | null useful_givens - = addArising orig (no_instance_msg <+> missing) + = addArising ct_loc (no_instance_msg <+> missing) | otherwise - = vcat (addArising orig (no_deduce_msg <+> missing) + = vcat (addArising ct_loc (no_deduce_msg <+> missing) : pp_givens useful_givens) supplementary = case mb_extra of @@ -2181,7 +2181,8 @@ pprTcSolverReportMsg ctxt (CouldNotDeduce useful_givens (item :| others) mb_extr -> Left [] Just (CND_Extra level ty1 ty2) -> mk_supplementary_ea_msg ctxt level ty1 ty2 orig - orig = errorItemOrigin item + ct_loc = errorItemCtLoc item + orig = ctLocOrigin ct_loc wanteds = map errorItemPred (item:others) no_instance_msg = @@ -2203,7 +2204,7 @@ pprTcSolverReportMsg ctxt (CouldNotDeduce useful_givens (item :| others) mb_extr pprTcSolverReportMsg ctxt (AmbiguityPreventsSolvingCt item ambigs) = pprTcSolverReportInfo ctxt (Ambiguity True ambigs) <+> - pprArising (errorItemOrigin item) $$ + pprArising (errorItemCtLoc item) $$ text "prevents the constraint" <+> quotes (pprParendType $ errorItemPred item) <+> text "from being solved." pprTcSolverReportMsg ctxt@(CEC {cec_encl = implics}) @@ -2304,7 +2305,7 @@ pprTcSolverReportMsg ctxt@(CEC {cec_encl = implics}) pprTcSolverReportMsg (CEC {cec_encl = implics}) (OverlappingInstances item matches unifiers) = vcat - [ addArising orig $ + [ addArising ct_loc $ (text "Overlapping instances for" <+> pprType (mkClassPred clas tys)) , ppUnless (null matching_givens) $ @@ -2339,7 +2340,8 @@ pprTcSolverReportMsg (CEC {cec_encl = implics}) (OverlappingInstances item match , text "when compiling the other instance declarations"] ])] where - orig = errorItemOrigin item + ct_loc = errorItemCtLoc item + orig = ctLocOrigin ct_loc pred = errorItemPred item (clas, tys) = getClassPredTys pred tyCoVars = tyCoVarsOfTypesList tys @@ -2363,7 +2365,7 @@ pprTcSolverReportMsg (CEC {cec_encl = implics}) (OverlappingInstances item match && isJust (tcMatchTys tys tys') Nothing -> False pprTcSolverReportMsg _ (UnsafeOverlap item matches unsafe_overlapped) = - vcat [ addArising orig (text "Unsafe overlapping instances for" + vcat [ addArising ct_loc (text "Unsafe overlapping instances for" <+> pprType (mkClassPred clas tys)) , sep [text "The matching instance is:", nest 2 (pprInstance $ head matches)] @@ -2375,7 +2377,7 @@ pprTcSolverReportMsg _ (UnsafeOverlap item matches unsafe_overlapped) = ] ] where - orig = errorItemOrigin item + ct_loc = errorItemCtLoc item pred = errorItemPred item (clas, tys) = getClassPredTys pred @@ -2906,20 +2908,28 @@ levelString :: TypeOrKind -> String levelString TypeLevel = "type" levelString KindLevel = "kind" -pprArising :: CtOrigin -> SDoc +pprArising :: CtLoc -> SDoc -- Used for the main, top-level error message -- We've done special processing for TypeEq, KindEq, givens -pprArising (TypeEqOrigin {}) = empty -pprArising (KindEqOrigin {}) = empty -pprArising (AmbiguityCheckOrigin {}) = empty -- the "In the ambiguity check" context - -- is sufficient; this would just be - -- repetitive -pprArising orig | isGivenOrigin orig = empty - | otherwise = pprCtOrigin orig +pprArising ct_loc + | in_generated_code = empty -- See Note ["Arising from" messages in generated code] + | suppress_origin = empty + | otherwise = pprCtOrigin orig + where + orig = ctLocOrigin ct_loc + in_generated_code = lclEnvInGeneratedCode (ctLocEnv ct_loc) + suppress_origin + | isGivenOrigin orig = True + | otherwise = case orig of + TypeEqOrigin {} -> True -- We've done special processing + KindEqOrigin {} -> True -- for TypeEq, KindEq, givens + AmbiguityCheckOrigin {} -> True -- The "In the ambiguity check" context + -- is sufficient; more would be repetitive + _ -> False -- Add the "arising from..." part to a message -addArising :: CtOrigin -> SDoc -> SDoc -addArising orig msg = hang msg 2 (pprArising orig) +addArising :: CtLoc -> SDoc -> SDoc +addArising ct_loc msg = hang msg 2 (pprArising ct_loc) pprWithArising :: [Ct] -> SDoc -- Print something like @@ -2931,7 +2941,7 @@ pprWithArising [] = panic "pprWithArising" pprWithArising (ct:cts) | null cts - = addArising (ctLocOrigin loc) (pprTheta [ctPred ct]) + = addArising loc (pprTheta [ctPred ct]) | otherwise = vcat (map ppr_one (ct:cts)) where @@ -2939,6 +2949,19 @@ pprWithArising (ct:cts) ppr_one ct' = hang (parens (pprType (ctPred ct'))) 2 (pprCtLoc (ctLoc ct')) +{- Note ["Arising from" messages in generated code] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider code generated when we desugar code before typechecking; +see Note [Rebindable syntax and HsExpansion]. + +In this code, constraints may be generated, but we don't want to +say "arising from a call of foo" if 'foo' doesn't appear in the +users code. We leave the actual CtOrigin untouched (partly because +it is generated in many, many places), but suppress the "Arising from" +message for constraints that originate in generated code. +-} + + {- ********************************************************************* * * SkolemInfo diff --git a/compiler/GHC/Tc/Gen/App.hs b/compiler/GHC/Tc/Gen/App.hs index e72e3ed194..8f59daf24a 100644 --- a/compiler/GHC/Tc/Gen/App.hs +++ b/compiler/GHC/Tc/Gen/App.hs @@ -733,18 +733,9 @@ tcInstFun do_ql inst_final (rn_fun, fun_ctxt) fun_sigma rn_args , text "do_ql" <+> ppr do_ql ]) ; go emptyVarSet [] [] fun_sigma rn_args } where - fun_loc = appCtxtLoc fun_ctxt fun_orig = exprCtOrigin (case fun_ctxt of VAExpansion e _ -> e VACall e _ _ -> e) - set_fun_ctxt thing_inside - | not (isGoodSrcSpan fun_loc) -- noSrcSpan => no arguments - = thing_inside -- => context is already set - | otherwise - = setSrcSpan fun_loc $ - case fun_ctxt of - VAExpansion orig _ -> addExprCtxt orig thing_inside - VACall {} -> thing_inside -- Count value args only when complaining about a function -- applied to too many value args @@ -803,9 +794,9 @@ tcInstFun do_ql inst_final (rn_fun, fun_ctxt) fun_sigma rn_args | (tvs, body1) <- tcSplitSomeForAllTyVars (inst_fun args) fun_ty , (theta, body2) <- tcSplitPhiTy body1 , not (null tvs && null theta) - = do { (inst_tvs, wrap, fun_rho) <- set_fun_ctxt $ + = do { (inst_tvs, wrap, fun_rho) <- addHeadCtxt fun_ctxt $ instantiateSigma fun_orig tvs theta body2 - -- set_fun_ctxt: important for the class constraints + -- addHeadCtxt: important for the class constraints -- that may be emitted from instantiating fun_sigma ; go (delta `extendVarSetList` inst_tvs) (addArgWrap wrap acc) so_far fun_rho args } @@ -894,19 +885,26 @@ tcInstFun do_ql inst_final (rn_fun, fun_ctxt) fun_sigma rn_args addArgCtxt :: AppCtxt -> LHsExpr GhcRn -> TcM a -> TcM a --- Adds a "In the third argument of f, namely blah" --- context, unless we are in generated code, in which case --- use "In the expression: arg" +-- There are two cases: +-- * In the normal case, we add an informative context +-- "In the third argument of f, namely blah" +-- * If we are deep inside generated code (isGeneratedCode) +-- or if all or part of this particular application is an expansion +-- (VAExpansion), just use the less-informative context +-- "In the expression: arg" +-- Unless the arg is also a generated thing, in which case do nothing. ---See Note [Rebindable syntax and HsExpansion] in GHC.Hs.Expr -addArgCtxt (VACall fun arg_no _) (L arg_loc arg) thing_inside - = setSrcSpanA arg_loc $ - addErrCtxt (funAppCtxt fun arg arg_no) $ - thing_inside - -addArgCtxt (VAExpansion {}) (L arg_loc arg) thing_inside - = setSrcSpanA arg_loc $ - addExprCtxt arg $ -- Auto-suppressed if arg_loc is generated - thing_inside +addArgCtxt ctxt (L arg_loc arg) thing_inside + = do { in_generated_code <- inGeneratedCode + ; case ctxt of + VACall fun arg_no _ | not in_generated_code + -> setSrcSpanA arg_loc $ + addErrCtxt (funAppCtxt fun arg arg_no) $ + thing_inside + + _ -> setSrcSpanA arg_loc $ + addExprCtxt arg $ -- Auto-suppressed if arg_loc is generated + thing_inside } {- ********************************************************************* * * diff --git a/compiler/GHC/Tc/Gen/Head.hs b/compiler/GHC/Tc/Gen/Head.hs index 296b223c8a..16d9cd05b8 100644 --- a/compiler/GHC/Tc/Gen/Head.hs +++ b/compiler/GHC/Tc/Gen/Head.hs @@ -31,7 +31,7 @@ module GHC.Tc.Gen.Head , tyConOf, tyConOfET, lookupParents, fieldNotInType , notSelector, nonBidirectionalErr - , addExprCtxt, addFunResCtxt ) where + , addHeadCtxt, addExprCtxt, addFunResCtxt ) where import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcExpr, tcCheckMonoExprNC, tcCheckPolyExprNC ) @@ -431,12 +431,11 @@ tcInferAppHead :: (HsExpr GhcRn, AppCtxt) -- -- See Note [tcApp: typechecking applications] in GHC.Tc.Gen.App tcInferAppHead (fun,ctxt) args - = setSrcSpan (appCtxtLoc ctxt) $ + = addHeadCtxt ctxt $ do { mb_tc_fun <- tcInferAppHead_maybe fun args ; case mb_tc_fun of Just (fun', fun_sigma) -> return (fun', fun_sigma) - Nothing -> add_head_ctxt fun args $ - tcInfer (tcExpr fun) } + Nothing -> tcInfer (tcExpr fun) } tcInferAppHead_maybe :: HsExpr GhcRn -> [HsExprArg 'TcpRn] @@ -447,20 +446,23 @@ tcInferAppHead_maybe fun args = case fun of HsVar _ (L _ nm) -> Just <$> tcInferId nm HsRecSel _ f -> Just <$> tcInferRecSelId f - ExprWithTySig _ e hs_ty -> add_head_ctxt fun args $ - Just <$> tcExprWithSig e hs_ty + ExprWithTySig _ e hs_ty -> Just <$> tcExprWithSig e hs_ty HsOverLit _ lit -> Just <$> tcInferOverLit lit HsSpliceE _ (HsSpliced _ _ (HsSplicedExpr e)) -> tcInferAppHead_maybe e args _ -> return Nothing -add_head_ctxt :: HsExpr GhcRn -> [HsExprArg 'TcpRn] -> TcM a -> TcM a --- Don't push an expression context if the arguments are empty, --- because it has already been pushed by tcExpr -add_head_ctxt fun args thing_inside - | null args = thing_inside - | otherwise = addExprCtxt fun thing_inside - +addHeadCtxt :: AppCtxt -> TcM a -> TcM a +addHeadCtxt fun_ctxt thing_inside + | not (isGoodSrcSpan fun_loc) -- noSrcSpan => no arguments + = thing_inside -- => context is already set + | otherwise + = setSrcSpan fun_loc $ + case fun_ctxt of + VAExpansion orig _ -> addExprCtxt orig thing_inside + VACall {} -> thing_inside + where + fun_loc = appCtxtLoc fun_ctxt {- ********************************************************************* * * diff --git a/compiler/GHC/Tc/Types.hs b/compiler/GHC/Tc/Types.hs index bce78dda31..f7dd7e7a9a 100644 --- a/compiler/GHC/Tc/Types.hs +++ b/compiler/GHC/Tc/Types.hs @@ -31,7 +31,7 @@ module GHC.Tc.Types( Env(..), TcGblEnv(..), TcLclEnv(..), setLclEnvTcLevel, getLclEnvTcLevel, - setLclEnvLoc, getLclEnvLoc, + setLclEnvLoc, getLclEnvLoc, lclEnvInGeneratedCode, IfGblEnv(..), IfLclEnv(..), tcVisibleOrphanMods, RewriteEnv(..), @@ -861,6 +861,9 @@ setLclEnvLoc env loc = env { tcl_loc = loc } getLclEnvLoc :: TcLclEnv -> RealSrcSpan getLclEnvLoc = tcl_loc +lclEnvInGeneratedCode :: TcLclEnv -> Bool +lclEnvInGeneratedCode = tcl_in_gen_code + type ErrCtxt = (Bool, TidyEnv -> TcM (TidyEnv, SDoc)) -- Monadic so that we have a chance -- to deal with bound type variables just before error diff --git a/compiler/GHC/Tc/Types.hs-boot b/compiler/GHC/Tc/Types.hs-boot index 42df1f4bc0..405374a06b 100644 --- a/compiler/GHC/Tc/Types.hs-boot +++ b/compiler/GHC/Tc/Types.hs-boot @@ -1,5 +1,6 @@ module GHC.Tc.Types where +import GHC.Prelude import GHC.Tc.Utils.TcType import GHC.Types.SrcLoc import GHC.Utils.Outputable @@ -19,3 +20,5 @@ getLclEnvTcLevel :: TcLclEnv -> TcLevel setLclEnvLoc :: TcLclEnv -> RealSrcSpan -> TcLclEnv getLclEnvLoc :: TcLclEnv -> RealSrcSpan + +lclEnvInGeneratedCode :: TcLclEnv -> Bool diff --git a/testsuite/tests/dependent/should_fail/T15859.stderr b/testsuite/tests/dependent/should_fail/T15859.stderr index be25e98708..9779cb5f1a 100644 --- a/testsuite/tests/dependent/should_fail/T15859.stderr +++ b/testsuite/tests/dependent/should_fail/T15859.stderr @@ -4,5 +4,6 @@ T15859.hs:9:19: error: forall k -> k -> * (GHC does not yet support this) • In an expression type signature: forall k -> k -> Type - In the expression: undefined :: forall k -> k -> Type In the expression: (undefined :: forall k -> k -> Type) @Int + In an equation for ‘a’: + a = (undefined :: forall k -> k -> Type) @Int diff --git a/testsuite/tests/dependent/should_fail/T15859a.stderr b/testsuite/tests/dependent/should_fail/T15859a.stderr index 491733c7b9..2d04f8d1fa 100644 --- a/testsuite/tests/dependent/should_fail/T15859a.stderr +++ b/testsuite/tests/dependent/should_fail/T15859a.stderr @@ -1,8 +1,8 @@ T15859a.hs:19:26: error: • Expected kind ‘k0’, but ‘A’ has kind ‘forall k -> k -> *’ - Cannot instantiate unification variable ‘k0’ + • Cannot instantiate unification variable ‘k0’ with a kind involving polytypes: forall k -> k -> * • In the first argument of ‘KindOf’, namely ‘A’ In an expression type signature: KindOf A - In the expression: undefined :: KindOf A + In the expression: (undefined :: KindOf A) @Int diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr index 38d9616489..f36e3d9385 100644 --- a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr +++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr @@ -1,11 +1,7 @@ -RecordDotSyntaxFail10.hs:40:11: - Couldn't match type ‘Int’ with ‘[Char]’ - arising from a functional dependency between: - constraint ‘HasField "quux" Quux String’ - arising from a use of ‘setField’ - instance ‘HasField "quux" Quux Int’ - at RecordDotSyntaxFail10.hs:34:10-33 - In the second argument of ‘($)’, namely ‘a {foo.bar.baz.quux}’ + +RecordDotSyntaxFail10.hs:40:11: error: + • Couldn't match type ‘Int’ with ‘[Char]’ + • In the second argument of ‘($)’, namely ‘a {foo.bar.baz.quux}’ In a stmt of a 'do' block: print $ a {foo.bar.baz.quux} In the expression: do let a = ... diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr index 595f32c8b2..1b90621057 100644 --- a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr +++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr @@ -17,7 +17,6 @@ RecordDotSyntaxFail11.hs:8:3: error: RecordDotSyntaxFail11.hs:8:11: error: • No instance for (GHC.Records.HasField "baz" Int a0) - arising from a use of ‘GHC.Records.getField’ • In the second argument of ‘($)’, namely ‘(.foo.bar.baz) a’ In a stmt of a 'do' block: print $ (.foo.bar.baz) a In the expression: diff --git a/testsuite/tests/parser/should_fail/T20654a.stderr b/testsuite/tests/parser/should_fail/T20654a.stderr index eb9ed41cd3..81760a572b 100644 --- a/testsuite/tests/parser/should_fail/T20654a.stderr +++ b/testsuite/tests/parser/should_fail/T20654a.stderr @@ -8,6 +8,5 @@ T20654a.hs:7:9: error: ‘?poly::forall a. a -> a’ arising from the type signature for: foo :: (?poly::forall a. a -> a) => Int -> Int at T20654a.hs:6:1-48 - • In the expression: ?poly - In the expression: ?poly x + • In the expression: ?poly x In an equation for ‘foo’: foo x = ?poly x diff --git a/testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr b/testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr index 285060c0c9..fa77d1d0f7 100644 --- a/testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr +++ b/testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr @@ -12,8 +12,9 @@ SplicesUsed.hs:8:14: warning: [-Wpartial-type-signatures (in -Wdefault)] the inferred type of <expression> :: w -> w at SplicesUsed.hs:8:14-23 • In an expression type signature: _a -> _a - In the expression: id :: _a -> _a In the expression: (id :: _a -> _a) (Just True :: Maybe _) + In an equation for ‘maybeBool’: + maybeBool = (id :: _a -> _a) (Just True :: Maybe _) • Relevant bindings include maybeBool :: Maybe Bool (bound at SplicesUsed.hs:8:1) @@ -81,4 +82,3 @@ SplicesUsed.hs:18:2: warning: [-Wpartial-type-signatures (in -Wdefault)] the inferred type of bar :: Bool -> w -> (Bool, w) at SplicesUsed.hs:18:2-11 • In the type signature: bar :: _a -> _b -> (_a, _b) - diff --git a/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInExpressionSignature.stderr b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInExpressionSignature.stderr index 823b1f9e5e..117a8cca0d 100644 --- a/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInExpressionSignature.stderr +++ b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInExpressionSignature.stderr @@ -5,8 +5,8 @@ ExtraConstraintsWildcardInExpressionSignature.hs:5:20: warning: [-Wpartial-type- the inferred type of <expression> :: Eq a1 => a1 -> a1 -> Bool at ExtraConstraintsWildcardInExpressionSignature.hs:5:20-25 • In an expression type signature: _ => _ - In the expression: (==) :: _ => _ In the expression: ((==) :: _ => _) x y + In an equation for ‘foo’: foo x y = ((==) :: _ => _) x y • Relevant bindings include y :: a (bound at ExtraConstraintsWildcardInExpressionSignature.hs:5:7) @@ -21,8 +21,8 @@ ExtraConstraintsWildcardInExpressionSignature.hs:5:25: warning: [-Wpartial-type- the inferred type of <expression> :: Eq a1 => a1 -> a1 -> Bool at ExtraConstraintsWildcardInExpressionSignature.hs:5:20-25 • In an expression type signature: _ => _ - In the expression: (==) :: _ => _ In the expression: ((==) :: _ => _) x y + In an equation for ‘foo’: foo x y = ((==) :: _ => _) x y • Relevant bindings include y :: a (bound at ExtraConstraintsWildcardInExpressionSignature.hs:5:7) diff --git a/testsuite/tests/typecheck/should_compile/T14590.stderr b/testsuite/tests/typecheck/should_compile/T14590.stderr index 4704a7aa01..19a4d72148 100644 --- a/testsuite/tests/typecheck/should_compile/T14590.stderr +++ b/testsuite/tests/typecheck/should_compile/T14590.stderr @@ -1,7 +1,8 @@ T14590.hs:4:11: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: Int -> Int -> Int - • In the expression: (x `_`) y + • In the expression: x `_` + In the expression: (x `_`) y In an equation for ‘f1’: f1 x y = (x `_`) y • Relevant bindings include y :: Int (bound at T14590.hs:4:6) @@ -88,7 +89,8 @@ T14590.hs:4:11: warning: [-Wtyped-holes (in -Wdefault)] T14590.hs:5:11: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _a :: Int -> Int -> Int Or perhaps ‘_a’ is mis-spelled, or not in scope - • In the expression: (x `_a`) y + • In the expression: x `_a` + In the expression: (x `_a`) y In an equation for ‘f2’: f2 x y = (x `_a`) y • Relevant bindings include y :: Int (bound at T14590.hs:5:6) diff --git a/testsuite/tests/typecheck/should_fail/tcfail104.stderr b/testsuite/tests/typecheck/should_fail/tcfail104.stderr index 0d9b338216..3645423c0a 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail104.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail104.stderr @@ -6,9 +6,11 @@ tcfail104.hs:16:12: error: Actual: (Char -> Char) -> Char -> Char • In the expression: \ x -> x In the expression: - if v then (\ (x :: forall a. a -> a) -> x) else (\ x -> x) - In the expression: (if v then (\ (x :: forall a. a -> a) -> x) else (\ x -> x)) id 'c' + In an equation for ‘f3’: + f3 v + = (if v then (\ (x :: forall a. a -> a) -> x) else (\ x -> x)) + id 'c' tcfail104.hs:22:12: error: • Couldn't match type: forall a. a -> a @@ -17,6 +19,8 @@ tcfail104.hs:22:12: error: Actual: (forall a. a -> a) -> Char -> Char • In the expression: \ (x :: forall a. a -> a) -> x In the expression: - if v then (\ x -> x) else (\ (x :: forall a. a -> a) -> x) - In the expression: (if v then (\ x -> x) else (\ (x :: forall a. a -> a) -> x)) id 'c' + In an equation for ‘f4’: + f4 v + = (if v then (\ x -> x) else (\ (x :: forall a. a -> a) -> x)) + id 'c' diff --git a/testsuite/tests/typecheck/should_fail/tcfail140.stderr b/testsuite/tests/typecheck/should_fail/tcfail140.stderr index da0141da67..cbac61f7d0 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail140.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail140.stderr @@ -30,7 +30,7 @@ tcfail140.hs:17:8: error: • In the pattern: Just The lambda expression ‘\ Just x -> x’ has two value arguments, but its type ‘Maybe a -> a’ has only one - In the expression: (\ Just x -> x) :: Maybe a -> a + In the expression: ((\ Just x -> x) :: Maybe a -> a) (Just 1) tcfail140.hs:20:1: error: • Couldn't match expected type ‘Int’ with actual type ‘p0 -> Bool’ |