diff options
-rw-r--r-- | compiler/rename/RnEnv.hs | 26 | ||||
-rw-r--r-- | testsuite/tests/rename/should_fail/T12686.hs | 13 | ||||
-rw-r--r-- | testsuite/tests/rename/should_fail/T12686.stderr | 4 | ||||
-rw-r--r-- | testsuite/tests/rename/should_fail/all.T | 1 |
4 files changed, 43 insertions, 1 deletions
diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs index 056f25c77c..801bc2724f 100644 --- a/compiler/rename/RnEnv.hs +++ b/compiler/rename/RnEnv.hs @@ -697,6 +697,9 @@ lookupOccRn rdr_name lookupKindOccRn :: RdrName -> RnM Name -- Looking up a name occurring in a kind lookupKindOccRn rdr_name + | isVarOcc (rdrNameOcc rdr_name) -- See Note [Promoted variables in types] + = badVarInType rdr_name + | otherwise = do { typeintype <- xoptM LangExt.TypeInType ; if | typeintype -> lookupTypeOccRn rdr_name -- With -XNoTypeInType, treat any usage of * in kinds as in scope @@ -709,6 +712,9 @@ lookupKindOccRn rdr_name lookupTypeOccRn :: RdrName -> RnM Name -- see Note [Demotion] lookupTypeOccRn rdr_name + | isVarOcc (rdrNameOcc rdr_name) -- See Note [Promoted variables in types] + = badVarInType rdr_name + | otherwise = do { mb_name <- lookupOccRn_maybe rdr_name ; case mb_name of { Just name -> return name ; @@ -758,7 +764,25 @@ is_star, is_uni_star :: RdrName -> Bool is_star = (fsLit "*" ==) . occNameFS . rdrNameOcc is_uni_star = (fsLit "★" ==) . occNameFS . rdrNameOcc -{- +badVarInType :: RdrName -> RnM Name +badVarInType rdr_name + = do { addErr (text "Illegal promoted term variable in a type:" + <+> ppr rdr_name) + ; return (mkUnboundNameRdr rdr_name) } + +{- Note [Promoted variables in types] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this (Trac #12686): + x = True + data Bad = Bad 'x + +The parser treats the quote in 'x as saying "use the term +namespace", so we'll get (Bad x{v}), with 'x' in the +VarName namespace. If we don't test for this, the renamer +will happily rename it to the x bound at top level, and then +the typecheck falls over because it doesn't have 'x' in scope +when kind-checking. + Note [Demotion] ~~~~~~~~~~~~~~~ When the user writes: diff --git a/testsuite/tests/rename/should_fail/T12686.hs b/testsuite/tests/rename/should_fail/T12686.hs new file mode 100644 index 0000000000..5d652f9c57 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T12686.hs @@ -0,0 +1,13 @@ +module T12686 where + +import Data.Proxy + +x = True + +data Bad = Bad 'x +-- The 'x should be rejeted in a civilised way + +data AlsoBad = AlsoBad { + a :: Int, + b :: Either Int 'a } +-- Ditto 'a here diff --git a/testsuite/tests/rename/should_fail/T12686.stderr b/testsuite/tests/rename/should_fail/T12686.stderr new file mode 100644 index 0000000000..24acc9c8c1 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T12686.stderr @@ -0,0 +1,4 @@ + +T12686.hs:7:16: error: Illegal promoted term variable in a type: x + +T12686.hs:12:19: error: Illegal promoted term variable in a type: a diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index f956bde8f4..b8c1ac51e5 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -141,3 +141,4 @@ test('T11071a', normal, compile_fail, ['']) test('T11663', normal, compile_fail, ['']) test('T12229', normal, compile, ['']) test('T12681', normal, multimod_compile_fail, ['T12681','-v0']) +test('T12686', normal, compile_fail, ['']) |