From c194ba74530bd51dc4349ab1bcc86bda5436d0da Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Thu, 28 Nov 2019 20:50:22 +0000
Subject: [PATCH] API Annotations: Unicode '->' on HsForallTy
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

The code fragment

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

Generates AnnRarrow instead of AnnRarrowU for the first →.

Fixes #17519

(cherry picked from commit f5866f9aa7fcdf81f8d385d33a842be6e7f2f210)
---
 compiler/parser/Parser.y                      |  2 +-
 testsuite/tests/ghc-api/annotations/Makefile  |  4 +++
 .../tests/ghc-api/annotations/T17519.stdout   | 25 +++++++++++++++++++
 .../tests/ghc-api/annotations/Test17519.hs    |  6 +++++
 testsuite/tests/ghc-api/annotations/all.T     |  2 ++
 5 files changed, 38 insertions(+), 1 deletion(-)
 create mode 100644 testsuite/tests/ghc-api/annotations/T17519.stdout
 create mode 100644 testsuite/tests/ghc-api/annotations/Test17519.hs

diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 5fea8646a433..3ca528d30cec 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -1872,7 +1872,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 3972e3d239d2..5f0fea1cc77c 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 000000000000..e71dd7f1a02f
--- /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 000000000000..f705008c5163
--- /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 f97e107c0a99..37b80794cd35 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'])
-- 
GitLab