summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2021-07-29 11:22:07 +0100
committerSimon Peyton Jones <simonpj@microsoft.com>2021-08-15 14:18:52 +0100
commit0f6fb7d309cbe69dcd534c14155d68c981895ab2 (patch)
tree0b3186625410632e0f01a4a07e30b73b9914e222
parent71130bf881fefccb4945b7c167d465ba94dda3ec (diff)
downloadhaskell-wip/T20181.tar.gz
TypeError is OK on the RHS of a type synonymwip/T20181
We should not complain about TypeError in type T = TypeError blah This fixes #20181 The error message for T13271 changes, because that test did indeed have a type synonym with TypeError on the RHS
-rw-r--r--compiler/GHC/Tc/Validity.hs11
-rw-r--r--testsuite/tests/indexed-types/should_fail/T13271.stderr24
-rw-r--r--testsuite/tests/typecheck/should_compile/T20181.hs8
-rw-r--r--testsuite/tests/typecheck/should_compile/all.T3
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, [''])
+