Parse symbolic names in ANN type correctly with otyconwip/T19374

This adds a new `otycon` production to the parser that allows for type
constructor names that are either alphanumeric (`tycon`) or symbolic
(`tyconsym`), where the latter must be parenthesized appropriately.
`otycon` is much like the existing `oqtycon` production, except that it does
not permit qualified names. The parser now uses `otycon` to parse type
constructor names in `ANN type` declarations, which fixes #19374.

To make sure that all of this works, I added three test cases:

* `should_compile/T19374a`: the original test case from #19374
* `should_fail/T19374b`: a test that makes sure that an `ANN` with a qualified
  name fails to parse
* `should_fail/T19374c`: a test that makes sure that an `ANN type` with a
  qualified name fails to parse

8 files changed, 33 insertions, 1 deletions

diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index 4b165b1586..4018155d81 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -1921,7 +1921,7 @@ annotation :: { LHsDecl GhcPs }
                                             (ValueAnnProvenance $2) $3))
                                             [mo $1,mc $4] }
 
-    | '{-# ANN' 'type' tycon aexp '#-}'  {% runPV (unECP $4) >>= \ $4 ->
+    | '{-# ANN' 'type' otycon aexp '#-}' {% runPV (unECP $4) >>= \ $4 ->
                                             ams (sLL $1 $> (AnnD noExtField $ HsAnnotation noExtField
                                             (getANN_PRAGs $1)
                                             (TypeAnnProvenance $3) $4))
@@ -3562,6 +3562,12 @@ tyconsym :: { Located RdrName }
         | '-'                   { sL1 $1 $! mkUnqual tcClsName (fsLit "-") }
         | '.'                   { sL1 $1 $! mkUnqual tcClsName (fsLit ".") }
 
+-- An "ordinary" unqualified tycon. See `oqtycon` for the qualified version.
+-- These can appear in `ANN type` declarations (#19374).
+otycon :: { Located RdrName }
+        : tycon                 { $1 }
+        | '(' tyconsym ')'      {% ams (sLL $1 $> (unLoc $2))
+                                       [mop $1,mj AnnVal $2,mcp $3] }
 
 -----------------------------------------------------------------------------
 -- Operators
diff --git a/testsuite/tests/annotations/should_compile/T19374a.hs b/testsuite/tests/annotations/should_compile/T19374a.hs
new file mode 100644
index 0000000000..95a1aa8baf
--- /dev/null
+++ b/testsuite/tests/annotations/should_compile/T19374a.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE TypeOperators #-}
+module T19374 where
+
+(%%) :: [a] -> [a] -> [a]
+(%%) = (++)
+{-# ANN (%%) "This is an annotation" #-}
+
+data (%%%)
+{-# ANN type (%%%) "This is also an annotation" #-}
diff --git a/testsuite/tests/annotations/should_compile/all.T b/testsuite/tests/annotations/should_compile/all.T
index be81c4fc19..8861d1baa3 100644
--- a/testsuite/tests/annotations/should_compile/all.T
+++ b/testsuite/tests/annotations/should_compile/all.T
@@ -4,6 +4,7 @@
 # now, just disable the profiling ways.
 test('ann01', [req_interp, omit_ways(prof_ways)], compile, ['-v0'])
 test('T14129', [req_interp, omit_ways(prof_ways)], compile, ['-v0'])
+test('T19374a', [req_interp, omit_ways(prof_ways)], compile, ['-v0'])
 
 """"
 Helpful things to C+P:
diff --git a/testsuite/tests/annotations/should_fail/T19374b.hs b/testsuite/tests/annotations/should_fail/T19374b.hs
new file mode 100644
index 0000000000..1ee5c6a9e3
--- /dev/null
+++ b/testsuite/tests/annotations/should_fail/T19374b.hs
@@ -0,0 +1,5 @@
+module T19347b where
+
+(%%) :: [a] -> [a] -> [a]
+(%%) = (++)
+{-# ANN (T19347b.%%) "This is an annotation" #-}
diff --git a/testsuite/tests/annotations/should_fail/T19374b.stderr b/testsuite/tests/annotations/should_fail/T19374b.stderr
new file mode 100644
index 0000000000..0d44c4c2e3
--- /dev/null
+++ b/testsuite/tests/annotations/should_fail/T19374b.stderr
@@ -0,0 +1,2 @@
+
+T19374b.hs:5:10: error: parse error on input ‘T19347b.%%’
diff --git a/testsuite/tests/annotations/should_fail/T19374c.hs b/testsuite/tests/annotations/should_fail/T19374c.hs
new file mode 100644
index 0000000000..d28af8049d
--- /dev/null
+++ b/testsuite/tests/annotations/should_fail/T19374c.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE TypeOperators #-}
+module T19347c where
+
+data (%%%)
+{-# ANN type (T19347c.%%%) "This is also an annotation" #-}
diff --git a/testsuite/tests/annotations/should_fail/T19374c.stderr b/testsuite/tests/annotations/should_fail/T19374c.stderr
new file mode 100644
index 0000000000..55700d006a
--- /dev/null
+++ b/testsuite/tests/annotations/should_fail/T19374c.stderr
@@ -0,0 +1,2 @@
+
+T19374c.hs:5:15: error: parse error on input ‘T19347c.%%%’
diff --git a/testsuite/tests/annotations/should_fail/all.T b/testsuite/tests/annotations/should_fail/all.T
index e15cd35322..1f160a0d77 100644
--- a/testsuite/tests/annotations/should_fail/all.T
+++ b/testsuite/tests/annotations/should_fail/all.T
@@ -16,6 +16,8 @@ test('annfail11', normal, compile_fail, [''])
 test('annfail12', req_interp, compile_fail, ['-v0'])
 test('annfail13', normal, compile_fail, [''])
 test('T10826', normal, compile_fail, [''])
+test('T19374b', normal, compile_fail, [''])
+test('T19374c', normal, compile_fail, [''])
 """"
 Helpful things to C+P: