diff options
| -rw-r--r-- | compiler/typecheck/TcTyClsDecls.hs | 12 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_fail/T17955.hs | 6 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_fail/T17955.stderr | 6 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_fail/all.T | 1 |
4 files changed, 21 insertions, 4 deletions
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index e85f471432..05a2a433a9 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -3992,9 +3992,6 @@ checkValidDataCon dflags existential_ok tc con -- Reason: it's really the argument of an equality constraint ; checkValidMonoType orig_res_ty - -- Check all argument types for validity - ; checkValidType ctxt (dataConUserType con) - -- If we are dealing with a newtype, we allow levity polymorphism -- regardless of whether or not UnliftedNewtypes is enabled. A -- later check in checkNewDataCon handles this, producing a @@ -4002,9 +3999,16 @@ checkValidDataCon dflags existential_ok tc con ; unless (isNewTyCon tc) (mapM_ (checkForLevPoly empty) (dataConOrigArgTys con)) - -- Extra checks for newtype data constructors + -- Extra checks for newtype data constructors. Importantly, these + -- checks /must/ come before the call to checkValidType below. This + -- is because checkValidType invokes the constraint solver, and + -- invoking the solver on an ill formed newtype constructor can + -- confuse GHC to the point of panicking. See #17955 for an example. ; when (isNewTyCon tc) (checkNewDataCon con) + -- Check all argument types for validity + ; checkValidType ctxt (dataConUserType con) + -- Check that existentials are allowed if they are used ; checkTc (existential_ok || isVanillaDataCon con) (badExistential con) diff --git a/testsuite/tests/typecheck/should_fail/T17955.hs b/testsuite/tests/typecheck/should_fail/T17955.hs new file mode 100644 index 0000000000..1bcb9a6d90 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T17955.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE FlexibleContexts #-} +module T17955 where + +import Data.Coerce + +newtype T = Coercible () T => T () diff --git a/testsuite/tests/typecheck/should_fail/T17955.stderr b/testsuite/tests/typecheck/should_fail/T17955.stderr new file mode 100644 index 0000000000..0762facf45 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T17955.stderr @@ -0,0 +1,6 @@ + +T17955.hs:6:13: error: + • A newtype constructor cannot have a context in its type + T :: Coercible () T => () -> T + • In the definition of data constructor ‘T’ + In the newtype declaration for ‘T’ diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 60e50ca241..1c2e55624a 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -557,3 +557,4 @@ test('T17566c', normal, compile_fail, ['']) test('T17773', normal, compile_fail, ['']) test('T17021', normal, compile_fail, ['']) test('T17021b', normal, compile_fail, ['']) +test('T17955', normal, compile_fail, ['']) |