diff options
author | Alan Zimmerman <alan.zimm@gmail.com> | 2019-02-02 16:29:05 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-02-08 11:00:22 -0500 |
commit | 5e9888bd9c22a1315a703f638591b50e657317c4 (patch) | |
tree | 5510eb74b731855569b38480df2af673680c09c6 | |
parent | cbfc9fcaa33c3b341830962906543dfca1dfedd7 (diff) | |
download | haskell-5e9888bd9c22a1315a703f638591b50e657317c4.tar.gz |
API Annotations: parens anns discarded for `(*)` operator
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
-rw-r--r-- | compiler/hsSyn/HsUtils.hs | 3 | ||||
-rw-r--r-- | compiler/parser/RdrHsSyn.hs | 4 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/annotations/Makefile | 4 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/annotations/StarBinderAnns.hs | 6 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/annotations/StarBinderAnns.stdout | 36 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/annotations/all.T | 4 | ||||
m--------- | utils/haddock | 0 |
7 files changed, 53 insertions, 4 deletions
diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs index dfb0ebf0db..23cca4c737 100644 --- a/compiler/hsSyn/HsUtils.hs +++ b/compiler/hsSyn/HsUtils.hs @@ -502,7 +502,8 @@ nlHsTyConApp tycon tys = foldl' nlHsAppTy (nlHsTyVar tycon) tys nlHsAppKindTy :: LHsType (GhcPass p) -> LHsKind (GhcPass p) -> LHsType (GhcPass p) -nlHsAppKindTy f k = noLoc (HsAppKindTy noExt f (parenthesizeHsType appPrec k)) +nlHsAppKindTy f k + = noLoc (HsAppKindTy noSrcSpan f (parenthesizeHsType appPrec k)) {- Tuples. All these functions are *pre-typechecker* because they lack diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index f9b511dd26..88217c27a2 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -957,10 +957,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 ef2b5eaafa..da3be434ff 100644 --- a/testsuite/tests/ghc-api/annotations/Makefile +++ b/testsuite/tests/ghc-api/annotations/Makefile @@ -157,3 +157,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 139c4412ed..8635ba1934 100644 --- a/testsuite/tests/ghc-api/annotations/all.T +++ b/testsuite/tests/ghc-api/annotations/all.T @@ -59,9 +59,11 @@ test('T13163', [extra_files(['Test13163.hs']), ignore_stderr], makefile_test, ['T13163']) test('T15303', [extra_files(['Test15303.hs']), ignore_stderr], makefile_test, ['T15303']) -test('T16212', [expect_broken(16212),extra_files(['Test16212.hs']), +test('T16212', [extra_files(['Test16212.hs']), ignore_stderr], makefile_test, ['T16212']) test('T16230', [extra_files(['Test16230.hs']), ignore_stderr], makefile_test, ['T16230']) test('T16236', [extra_files(['Test16236.hs']), ignore_stderr], makefile_test, ['T16236']) +test('StarBinderAnns', [extra_files(['StarBinderAnns.hs']), + ignore_stderr], makefile_test, ['StarBinderAnns']) diff --git a/utils/haddock b/utils/haddock -Subproject cfd682c5fd03b099a3d78c44f9279faf56a0ac7 +Subproject 3ee6526d4ae7bf4deb7cd1caf24b3d735557357 |