diff options
| -rw-r--r-- | compiler/GHC/Tc/Validity.hs | 11 | ||||
| -rw-r--r-- | testsuite/tests/indexed-types/should_fail/T13271.stderr | 24 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_compile/T20181.hs | 8 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_compile/all.T | 3 |
4 files changed, 39 insertions, 7 deletions
diff --git a/compiler/GHC/Tc/Validity.hs b/compiler/GHC/Tc/Validity.hs index 3445270c9a..4c141ce082 100644 --- a/compiler/GHC/Tc/Validity.hs +++ b/compiler/GHC/Tc/Validity.hs @@ -241,7 +241,7 @@ wantAmbiguityCheck ctxt StandaloneKindSigCtxt{} -> False _ -> True -checkUserTypeError :: Type -> TcM () +checkUserTypeError :: UserTypeCtxt -> Type -> TcM () -- Check to see if the type signature mentions "TypeError blah" -- anywhere in it, and fail if so. -- @@ -250,7 +250,12 @@ checkUserTypeError :: Type -> TcM () -- user-supplied one. This is really only a half-baked fix; -- the other errors in checkValidType don't do tidying, and so -- may give bad error messages when given an inferred type. -checkUserTypeError = check +checkUserTypeError ctxt ty + | TySynCtxt {} <- ctxt -- Do not complain about TypeError on the + = return () -- RHS of type synonyms. See #20181 + + | otherwise + = check ty where check ty | Just msg <- userTypeError_maybe ty = fail_with msg @@ -393,7 +398,7 @@ checkValidType ctxt ty -- (and more complicated) errors in checkAmbiguity ; checkNoErrs $ do { check_type ve ty - ; checkUserTypeError ty + ; checkUserTypeError ctxt ty ; traceTc "done ct" (ppr ty) } -- Check for ambiguous types. See Note [When to call checkAmbiguity] diff --git a/testsuite/tests/indexed-types/should_fail/T13271.stderr b/testsuite/tests/indexed-types/should_fail/T13271.stderr index e28dcea3c2..5899110be4 100644 --- a/testsuite/tests/indexed-types/should_fail/T13271.stderr +++ b/testsuite/tests/indexed-types/should_fail/T13271.stderr @@ -1,4 +1,22 @@ -T13271.hs:9:1: error: - • You can't do that! - • In the type synonym declaration for ‘T2’ +T13271.hs:12:3: error: + • Type family equation right-hand sides overlap; this violates + the family's injectivity annotation: + X 1 = T1 -- Defined at T13271.hs:12:3 + X 2 = T2 -- Defined at T13271.hs:13:3 + • In the equations for closed type family ‘X’ + In the type family declaration for ‘X’ + +T13271.hs:13:3: error: + • Type family equation violates the family's injectivity annotation. + RHS of injective type family equation cannot be a type family: + X 2 = T2 -- Defined at T13271.hs:13:3 + • In the equations for closed type family ‘X’ + In the type family declaration for ‘X’ + +T13271.hs:13:3: error: + • The type family application ‘(TypeError ...)’ + is no smaller than the instance head ‘X 2’ + (Use UndecidableInstances to permit this) + • In the equations for closed type family ‘X’ + In the type family declaration for ‘X’ diff --git a/testsuite/tests/typecheck/should_compile/T20181.hs b/testsuite/tests/typecheck/should_compile/T20181.hs new file mode 100644 index 0000000000..889b3db149 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T20181.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE DataKinds #-} + +module T20181 where + +import GHC.TypeLits( TypeError, ErrorMessage(..) ) + +-- This should be fine +type Foo = TypeError (Text "foo") diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 83688dbb9b..7498e23a8e 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -793,5 +793,6 @@ test('T18481a', normal, compile, ['']) test('T19775', normal, compile, ['']) test('T17817b', normal, compile, ['']) test('T20033', normal, compile, ['']) - test('TypeRepCon', normal, compile, ['-Woverlapping-patterns']) +test('T20181', normal, compile, ['']) + |