API Annotations: Unicode '->' on HsForallTy

The code fragment

  type family Proxy2' ∷ ∀ k → k → Type where
    Proxy2' = Proxy'

Generates AnnRarrow instead of AnnRarrowU for the first →.

Fixes #17519

5 files changed, 38 insertions, 1 deletions

diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 3a6ab1bc5b..0076a01992 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -1885,7 +1885,7 @@ unpackedness :: { Located ([AddAnn], SourceText, SrcUnpackedness) }
 
 forall_vis_flag :: { (AddAnn, ForallVisFlag) }
         : '.'  { (mj AnnDot $1,    ForallInvis) }
-        | '->' { (mj AnnRarrow $1, ForallVis)   }
+        | '->' { (mu AnnRarrow $1, ForallVis)   }
 
 -- A ktype/ktypedoc is a ctype/ctypedoc, possibly with a kind annotation
 ktype :: { LHsType GhcPs }
diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile
index 3972e3d239..5f0fea1cc7 100644
--- a/testsuite/tests/ghc-api/annotations/Makefile
+++ b/testsuite/tests/ghc-api/annotations/Makefile
@@ -169,3 +169,7 @@ T16279:
 .PHONY: T17388
 T17388:
 	$(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test17388.hs
+
+.PHONY: T17519
+T17519:
+	$(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test17519.hs
diff --git a/testsuite/tests/ghc-api/annotations/T17519.stdout b/testsuite/tests/ghc-api/annotations/T17519.stdout
new file mode 100644
index 0000000000..e71dd7f1a0
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations/T17519.stdout
@@ -0,0 +1,25 @@
+---Unattached Annotation Problems (should be empty list)---
+[]
+---Ann before enclosing span problem (should be empty list)---
+[
+
+]
+
+---Annotations-----------------------
+-- SrcSpan the annotation is attached to, AnnKeywordId,
+--    list of locations the keyword item appears in
+[
+((Test17519.hs:1:1,AnnModule), [Test17519.hs:3:1-6]),
+((Test17519.hs:1:1,AnnWhere), [Test17519.hs:3:18-22]),
+((Test17519.hs:5:1-36,AnnDcolonU), [Test17519.hs:5:21]),
+((Test17519.hs:5:1-36,AnnFamily), [Test17519.hs:5:6-11]),
+((Test17519.hs:5:1-36,AnnSemi), [Test17519.hs:7:1]),
+((Test17519.hs:5:1-36,AnnType), [Test17519.hs:5:1-4]),
+((Test17519.hs:5:1-36,AnnWhere), [Test17519.hs:5:38-42]),
+((Test17519.hs:5:23-36,AnnForallU), [Test17519.hs:5:23]),
+((Test17519.hs:5:23-36,AnnRarrowU), [Test17519.hs:5:27]),
+((Test17519.hs:5:29,AnnRarrowU), [Test17519.hs:5:31]),
+((Test17519.hs:5:29-36,AnnRarrowU), [Test17519.hs:5:31]),
+((Test17519.hs:6:3-18,AnnEqual), [Test17519.hs:6:11]),
+((<no location info>,AnnEofPos), [Test17519.hs:7:1])
+]
diff --git a/testsuite/tests/ghc-api/annotations/Test17519.hs b/testsuite/tests/ghc-api/annotations/Test17519.hs
new file mode 100644
index 0000000000..f705008c51
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations/Test17519.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE UnicodeSyntax #-}
+module Test17519 where
+
+type family Proxy2' ∷ ∀ k → k → Type where
+  Proxy2' = Proxy'
diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T
index f97e107c0a..37b80794cd 100644
--- a/testsuite/tests/ghc-api/annotations/all.T
+++ b/testsuite/tests/ghc-api/annotations/all.T
@@ -71,3 +71,5 @@ test('T16279',      [extra_files(['Test16279.hs']),
                      ignore_stderr], makefile_test, ['T16279'])
 test('T17388',      [extra_files(['Test17388.hs']),
                      ignore_stderr], makefile_test, ['T17388'])
+test('T17519',      [extra_files(['Test17519.hs']),
+                     ignore_stderr], makefile_test, ['T17519'])