diff options
| author | Matthew Pickering <matthewtpickering@gmail.com> | 2021-09-13 17:31:41 +0100 |
|---|---|---|
| committer | Matthew Pickering <matthewtpickering@gmail.com> | 2021-09-13 17:32:39 +0100 |
| commit | 5176393751c30532edf4382c2037f56c4e714709 (patch) | |
| tree | ddedd6e7a27bf9f34dd78cef3bb05c30d71ff0d1 | |
| parent | 2d15175266d0e0d9ca6565124b0c17e207b5541c (diff) | |
| download | haskell-wip/t19519.tar.gz | |
lint: Fix scoping for case alt_ty checkwip/t19519
The type of the alt_ty can mention a coercion variable bound by the
case, therefore check the validity of the alt_ty in the scope where the
coercion variable is bound.
Fixes #19519
| -rw-r--r-- | compiler/GHC/Core/Lint.hs | 5 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_compile/T19519.hs | 11 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_compile/all.T | 1 |
3 files changed, 15 insertions, 2 deletions
diff --git a/compiler/GHC/Core/Lint.hs b/compiler/GHC/Core/Lint.hs index 405f2c1116..55e47ab22a 100644 --- a/compiler/GHC/Core/Lint.hs +++ b/compiler/GHC/Core/Lint.hs @@ -1309,8 +1309,6 @@ lintCaseExpr scrut var alt_ty alts = -- in GHC.Core ; let scrut_mult = varMult var - ; alt_ty <- addLoc (CaseTy scrut) $ - lintValueType alt_ty ; var_ty <- addLoc (IdTy var) $ lintValueType (idType var) @@ -1348,6 +1346,9 @@ lintCaseExpr scrut var alt_ty alts = ; lintBinder CaseBind var $ \_ -> do { -- Check the alternatives + + ; alt_ty <- addLoc (CaseTy scrut) $ + lintValueType alt_ty ; alt_ues <- mapM (lintCoreAlt var scrut_ty scrut_mult alt_ty) alts ; let case_ue = (scaleUE scrut_mult scrut_ue) `addUE` supUEs alt_ues ; checkCaseAlts e scrut_ty alts diff --git a/testsuite/tests/typecheck/should_compile/T19519.hs b/testsuite/tests/typecheck/should_compile/T19519.hs new file mode 100644 index 0000000000..716dc3167b --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T19519.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE DeriveLift #-} +{-# LANGUAGE TemplateHaskell #-} +module T19519 where + +import qualified Language.Haskell.TH.Syntax as TH + +data VendorEnv = A + +instance TH.Lift VendorEnv where + liftTyped _ = [|| A ||] + diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 72105683a5..b158400f9d 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -796,3 +796,4 @@ test('T20033', normal, compile, ['']) test('TypeRepCon', normal, compile, ['-Woverlapping-patterns']) test('T20181', normal, compile, ['']) test('T20241', normal, compile, ['']) +test('T19519', normal, compile, ['']) |