Commit 711929e6 authored by Simon Peyton Jones's avatar Simon Peyton Jones Committed by Marge Bot

Fix error message location in tcCheckPatSynDecl

Ticket #18856 showed that we were failing to set the right location
for an error message.  Easy to fix, happily.

Turns out that this also improves the error location in test T11010,
which was bogus before but we had never noticed.
parent e2c4a947
......@@ -31,9 +31,9 @@ import GHC.Tc.Utils.TcMType
import GHC.Tc.Utils.Zonk
import GHC.Builtin.Types.Prim
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.SrcLoc
import GHC.Core.PatSyn
import GHC.Types.Name.Set
import GHC.Utils.Panic
import GHC.Utils.Outputable
import GHC.Data.FastString
......@@ -422,14 +422,22 @@ tcCheckPatSynDecl psb@PSB{ psb_id = lname@(L _ name), psb_args = details
; tc_patsyn_finish lname dir is_infix lpat'
(univ_bndrs, req_theta, ev_binds, req_dicts)
(ex_bndrs, mkTyVarTys ex_tvs', prov_theta, prov_dicts)
(args', (map scaledThing arg_tys))
(args', map scaledThing arg_tys)
pat_ty rec_fields }
where
tc_arg :: TCvSubst -> Name -> Type -> TcM (LHsExpr GhcTc)
-- Look up the variable actually bound by lpat
-- and check that it has the expected type
tc_arg subst arg_name arg_ty
= do { -- Look up the variable actually bound by lpat
-- and check that it has the expected type
arg_id <- tcLookupId arg_name
= setSrcSpan (nameSrcSpan arg_name) $
-- Set the SrcSpan to be the binding site of the Id (#18856)
-- e.g. pattern P :: Int -> Maybe (Int,Bool)
-- pattern P x = Just (x,True)
-- Before unifying x's actual type with its expected type, in tc_arg, set
-- location to x's binding site in lpat, namely the 'x' in Just (x,True).
-- Else the error message location is wherever tcCheckPat finished,
-- namely the right-hand corner of the pattern
do { arg_id <- tcLookupId arg_name
; wrap <- tcSubTypeSigma GenSigCtxt
(idType arg_id)
(substTyUnchecked subst arg_ty)
......
T11010.hs:9:36: error:
T11010.hs:9:34: error:
• Couldn't match type ‘a1’ with ‘Int’
Expected: a -> b
Actual: a1 -> b
......@@ -12,3 +12,6 @@ T11010.hs:9:36: error:
• Relevant bindings include
x :: Expr a1 (bound at T11010.hs:9:36)
f :: a1 -> b (bound at T11010.hs:9:34)
|
9 | pattern IntFun str f x = Fun str f x
| ^
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
module T18856 where
pattern P :: Int -> Bool -> (Int, Bool, [(Bool,Bool)])
pattern P p q <- (q, p, [(True,False)])
T18856.hs:6:19: error:
• Couldn't match expected type ‘Bool’ with actual type ‘Int’
• In the declaration for pattern synonym ‘P’
|
6 | pattern P p q <- (q, p, [(True,False)])
| ^
T18856.hs:6:22: error:
• Couldn't match expected type ‘Int’ with actual type ‘Bool’
• In the declaration for pattern synonym ‘P’
|
6 | pattern P p q <- (q, p, [(True,False)])
| ^
......@@ -9,7 +9,7 @@ test('T9705-2', normal, compile_fail, [''])
test('unboxed-bind', normal, compile_fail, [''])
test('unboxed-wrapper-naked', normal, compile_fail, [''])
test('T10873', normal, compile_fail, [''])
test('T11010', normal, compile_fail, [''])
test('T11010', normal, compile_fail, ['-fdiagnostics-show-caret'])
test('records-check-sels', normal, compile_fail, [''])
test('records-no-uni-update', normal, compile_fail, [''])
test('records-no-uni-update2', normal, compile_fail, [''])
......@@ -47,3 +47,4 @@ test('T15692', normal, compile, ['']) # It has -fdefer-type-errors inside
test('T15694', normal, compile_fail, [''])
test('T16900', normal, compile_fail, ['-fdiagnostics-show-caret'])
test('T14552', normal, compile_fail, [''])
test('T18856', normal, compile_fail, ['-fdiagnostics-show-caret'])
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