diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs index ec166205155e6606a2bc4a151ffaff5cd9185dad..969fade07a5ae0319006ac173dec9802e25cc0b1 100644 --- a/compiler/GHC/Tc/Errors.hs +++ b/compiler/GHC/Tc/Errors.hs @@ -1563,16 +1563,19 @@ validHoleFits :: SolverReportErrCtxt -- ^ The context we're in, i.e. the -- the valid hole fits. validHoleFits ctxt@(CEC { cec_encl = implics , cec_tidy = lcl_env}) simps hole - = do { (tidy_env, fits) <- findValidHoleFits lcl_env implics (map mk_wanted simps) hole + = do { (tidy_env, fits) <- findValidHoleFits lcl_env implics (mapMaybe mk_wanted simps) hole ; return (ctxt {cec_tidy = tidy_env}, fits) } where - mk_wanted :: ErrorItem -> CtEvidence - mk_wanted (EI { ei_pred = pred, ei_evdest = Just dest, ei_loc = loc }) - = CtWanted { ctev_pred = pred - , ctev_dest = dest - , ctev_loc = loc - , ctev_rewriters = emptyRewriterSet } - mk_wanted item = pprPanic "validHoleFits no evdest" (ppr item) + mk_wanted :: ErrorItem -> Maybe CtEvidence + mk_wanted (EI { ei_pred = pred, ei_evdest = m_dest, ei_loc = loc }) + | Just dest <- m_dest + = Just (CtWanted { ctev_pred = pred + , ctev_dest = dest + , ctev_loc = loc + , ctev_rewriters = emptyRewriterSet }) + | otherwise + = Nothing -- The ErrorItem was a Given + -- See Note [Constraints include ...] givenConstraints :: SolverReportErrCtxt -> [(Type, RealSrcSpan)] diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs index 5da28d8088066732f19b03c6177d03b6bcd91084..d55b13f68347d387244e825324be20663779a3bb 100644 --- a/compiler/GHC/Tc/Errors/Types.hs +++ b/compiler/GHC/Tc/Errors/Types.hs @@ -4863,7 +4863,9 @@ data ErrorItem = EI { ei_pred :: PredType -- report about this -- The ei_pred field will never be an unboxed equality with -- a (casted) tyvar on the right; this is guaranteed by the solver - , ei_evdest :: Maybe TcEvDest -- for Wanteds, where to put evidence + , ei_evdest :: Maybe TcEvDest + -- ^ for Wanteds, where to put the evidence + -- for Givens, Nothing , ei_flavour :: CtFlavour , ei_loc :: CtLoc , ei_m_reason :: Maybe CtIrredReason -- if this ErrorItem was made from a diff --git a/testsuite/tests/typecheck/should_fail/T22684.hs b/testsuite/tests/typecheck/should_fail/T22684.hs new file mode 100644 index 0000000000000000000000000000000000000000..60a95f3e14b6254fabbd5b9bef1cce05f126a684 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T22684.hs @@ -0,0 +1,19 @@ +module T22684 where + +-- Example 1 from #22684 +p :: (Int ~ Bool => r) -> r +p _ = undefined + +q :: r +q = p _ + +-- Example 3 from #22684 +class Category k where + (.) :: k b c -> k a b -> k a c + +data Free p a b where + Prod :: Free p a (b, c) + Sum :: Free p (Either a b) c + +instance Category (Free p) where + Sum . Prod = _ diff --git a/testsuite/tests/typecheck/should_fail/T22684.stderr b/testsuite/tests/typecheck/should_fail/T22684.stderr new file mode 100644 index 0000000000000000000000000000000000000000..cead5f8d902db9188d5c8f54ce1825f7ffaed5eb --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T22684.stderr @@ -0,0 +1,35 @@ + +T22684.hs:8:7: error: [GHC-88464] + • Found hole: _ :: r + Where: ‘r’ is a rigid type variable bound by + the type signature for: + q :: forall r. r + at T22684.hs:7:1-6 + • In the first argument of ‘p’, namely ‘_’ + In the expression: p _ + In an equation for ‘q’: q = p _ + • Relevant bindings include q :: r (bound at T22684.hs:8:1) + Constraints include Int ~ Bool (from T22684.hs:8:7) + Valid hole fits include q :: r (bound at T22684.hs:8:1) + +T22684.hs:19:16: error: [GHC-88464] + • Found hole: _ :: Free p a c + Where: ‘k’, ‘p’ are rigid type variables bound by + the instance declaration + at T22684.hs:18:10-26 + ‘a’, ‘c’ are rigid type variables bound by + the type signature for: + (T22684..) :: forall b c a. Free p b c -> Free p a b -> Free p a c + at T22684.hs:19:7 + • In an equation for ‘T22684..’: Sum T22684.. Prod = _ + In the instance declaration for ‘Category (Free p)’ + • Relevant bindings include + (.) :: Free p b c -> Free p a b -> Free p a c + (bound at T22684.hs:19:7) + Constraints include + b ~ (b2, c1) (from T22684.hs:19:9-12) + b ~ Either a1 b1 (from T22684.hs:19:3-5) + Valid hole fits include + q :: forall r. r + with q @(Free p a c) + (bound at T22684.hs:8:1) diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index a1805014c858201e4be30900a5d98f43a6fdd062..d1d77f90536aa006f42e3e501d48aaaa38a5bb74 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -696,3 +696,4 @@ test('VisFlag2', normal, compile_fail, ['']) test('VisFlag3', normal, compile_fail, ['']) test('VisFlag4', normal, compile_fail, ['']) test('VisFlag5', normal, compile_fail, ['']) +test('T22684', normal, compile_fail, [''])