summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlan Zimmerman <alan.zimm@gmail.com>2019-02-02 16:29:05 +0200
committerAlan Zimmerman <alan.zimm@gmail.com>2019-02-27 21:10:24 +0200
commit3ad6d4f5623c8ddc86e71bd6c1ae31710fd9e14a (patch)
treeb7502c3a0e331f8ea81de4763b5f0df1d1e3b4ed
parent91ba643c1bbdc2c10504a66674f9bd83fec5151d (diff)
downloadhaskell-wip/ghc-8.8-az.tar.gz
API Annotations: parens anns discarded for `(*)` operatorwip/ghc-8.8-az
The patch from https://phabricator.haskell.org/D4865 introduces go _ (HsParTy _ (dL->L l (HsStarTy _ isUni))) acc ann fix = do { warnStarBndr l ; let name = mkOccName tcClsName (if isUni then "★" else "*") ; return (cL l (Unqual name), acc, fix, ann) } which discards the parens annotations belonging to the HsParTy. Updates haddock submodule Closes #16265 (cherry picked from commit 5e9888bd9c22a1315a703f638591b50e657317c4)
-rw-r--r--compiler/parser/RdrHsSyn.hs4
-rw-r--r--testsuite/tests/ghc-api/annotations/Makefile4
-rw-r--r--testsuite/tests/ghc-api/annotations/StarBinderAnns.hs6
-rw-r--r--testsuite/tests/ghc-api/annotations/StarBinderAnns.stdout36
-rw-r--r--testsuite/tests/ghc-api/annotations/all.T2
5 files changed, 50 insertions, 2 deletions
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index 00212c7951..fba5863a8b 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -960,10 +960,10 @@ checkTyClHdr is_cls ty
goL (dL->L l ty) acc ann fix = go l ty acc ann fix
-- workaround to define '*' despite StarIsType
- go _ (HsParTy _ (dL->L l (HsStarTy _ isUni))) acc ann fix
+ go lp (HsParTy _ (dL->L l (HsStarTy _ isUni))) acc ann fix
= do { warnStarBndr l
; let name = mkOccName tcClsName (if isUni then "★" else "*")
- ; return (cL l (Unqual name), acc, fix, ann) }
+ ; return (cL l (Unqual name), acc, fix, (ann ++ mkParensApiAnn lp)) }
go l (HsTyVar _ _ (dL->L _ tc)) acc ann fix
| isRdrTc tc = return (cL l tc, acc, fix, ann)
diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile
index 33eabdea85..37aaa8a425 100644
--- a/testsuite/tests/ghc-api/annotations/Makefile
+++ b/testsuite/tests/ghc-api/annotations/Makefile
@@ -161,3 +161,7 @@ T16230:
.PHONY: T16236
T16236:
$(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test16236.hs
+
+.PHONY: StarBinderAnns
+StarBinderAnns:
+ $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" StarBinderAnns.hs
diff --git a/testsuite/tests/ghc-api/annotations/StarBinderAnns.hs b/testsuite/tests/ghc-api/annotations/StarBinderAnns.hs
new file mode 100644
index 0000000000..4b69f44d66
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations/StarBinderAnns.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE TypeOperators, TypeFamilies #-}
+{-# OPTIONS -Wno-star-is-type #-}
+
+module X (type (X.*)) where
+
+type family (*) a b where { (*) a b = Either b a }
diff --git a/testsuite/tests/ghc-api/annotations/StarBinderAnns.stdout b/testsuite/tests/ghc-api/annotations/StarBinderAnns.stdout
new file mode 100644
index 0000000000..d75f30a9d8
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations/StarBinderAnns.stdout
@@ -0,0 +1,36 @@
+---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
+[
+((StarBinderAnns.hs:1:1,AnnModule), [StarBinderAnns.hs:4:1-6]),
+((StarBinderAnns.hs:1:1,AnnWhere), [StarBinderAnns.hs:4:23-27]),
+((StarBinderAnns.hs:4:10-21,AnnCloseP), [StarBinderAnns.hs:4:21]),
+((StarBinderAnns.hs:4:10-21,AnnOpenP), [StarBinderAnns.hs:4:10]),
+((StarBinderAnns.hs:4:11-20,AnnType), [StarBinderAnns.hs:4:11-14]),
+((StarBinderAnns.hs:4:16-20,AnnCloseP), [StarBinderAnns.hs:4:20]),
+((StarBinderAnns.hs:4:16-20,AnnOpenP), [StarBinderAnns.hs:4:16]),
+((StarBinderAnns.hs:4:16-20,AnnVal), [StarBinderAnns.hs:4:17-19]),
+((StarBinderAnns.hs:6:1-19,AnnCloseC), [StarBinderAnns.hs:6:50]),
+((StarBinderAnns.hs:6:1-19,AnnCloseP), [StarBinderAnns.hs:6:15]),
+((StarBinderAnns.hs:6:1-19,AnnFamily), [StarBinderAnns.hs:6:6-11]),
+((StarBinderAnns.hs:6:1-19,AnnOpenC), [StarBinderAnns.hs:6:27]),
+((StarBinderAnns.hs:6:1-19,AnnOpenP), [StarBinderAnns.hs:6:13]),
+((StarBinderAnns.hs:6:1-19,AnnSemi), [StarBinderAnns.hs:7:1]),
+((StarBinderAnns.hs:6:1-19,AnnType), [StarBinderAnns.hs:6:1-4]),
+((StarBinderAnns.hs:6:1-19,AnnWhere), [StarBinderAnns.hs:6:21-25]),
+((StarBinderAnns.hs:6:13-15,AnnCloseP), [StarBinderAnns.hs:6:15]),
+((StarBinderAnns.hs:6:13-15,AnnOpenP), [StarBinderAnns.hs:6:13]),
+((StarBinderAnns.hs:6:29-31,AnnCloseP), [StarBinderAnns.hs:6:31]),
+((StarBinderAnns.hs:6:29-31,AnnOpenP), [StarBinderAnns.hs:6:29]),
+((StarBinderAnns.hs:6:29-48,AnnCloseP), [StarBinderAnns.hs:6:31]),
+((StarBinderAnns.hs:6:29-48,AnnEqual), [StarBinderAnns.hs:6:37]),
+((StarBinderAnns.hs:6:29-48,AnnOpenP), [StarBinderAnns.hs:6:29]),
+((<no location info>,AnnEofPos), [StarBinderAnns.hs:7:1])
+] \ No newline at end of file
diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T
index 8cad6fc816..87ce66c18e 100644
--- a/testsuite/tests/ghc-api/annotations/all.T
+++ b/testsuite/tests/ghc-api/annotations/all.T
@@ -67,3 +67,5 @@ test('T16230', [extra_files(['Test16230.hs']),
ignore_stderr], run_command, ['$MAKE -s --no-print-directory T16230'])
test('T16236', [extra_files(['Test16236.hs']),
ignore_stderr], run_command, ['$MAKE -s --no-print-directory T16236'])
+test('StarBinderAnns', [extra_files(['StarBinderAnns.hs']),
+ ignore_stderr], run_command, ['$MAKE -s --no-print-directory StarBinderAnns'])