summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/rename/RnEnv.hs26
-rw-r--r--testsuite/tests/rename/should_fail/T12686.hs13
-rw-r--r--testsuite/tests/rename/should_fail/T12686.stderr4
-rw-r--r--testsuite/tests/rename/should_fail/all.T1
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, [''])