[commit: ghc] wip/T16265: API Annotations: parens anns discarded for `(*)` operator (3200c30)

git at git.haskell.org git at git.haskell.org
Sun Feb 3 11:26:10 UTC 2019


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/T16265
Link       : http://ghc.haskell.org/trac/ghc/changeset/3200c30f1f7af2a3fa54773129cb21a5c72527d2/ghc

>---------------------------------------------------------------

commit 3200c30f1f7af2a3fa54773129cb21a5c72527d2
Author: Alan Zimmerman <alan.zimm at gmail.com>
Date:   Sat Feb 2 16:29:05 2019 +0200

    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.
    
    Closes #16265


>---------------------------------------------------------------

3200c30f1f7af2a3fa54773129cb21a5c72527d2
 compiler/parser/RdrHsSyn.hs                        |  4 +--
 testsuite/tests/ghc-api/annotations/Makefile       |  4 +++
 .../annotations/StarBinderAnns.hs}                 |  0
 .../ghc-api/annotations/StarBinderAnns.stdout      | 36 ++++++++++++++++++++++
 testsuite/tests/ghc-api/annotations/all.T          |  7 +++--
 5 files changed, 46 insertions(+), 5 deletions(-)

diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index 45fc5a0..13817d8 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -959,10 +959,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 2478f29..2eba3eb 100644
--- a/testsuite/tests/ghc-api/annotations/Makefile
+++ b/testsuite/tests/ghc-api/annotations/Makefile
@@ -149,3 +149,7 @@ T15303:
 .PHONY: T16212
 T16212:
 	$(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test16212.hs
+
+.PHONY: StarBinderAnns
+StarBinderAnns:
+	$(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" StarBinderAnns.hs
diff --git a/testsuite/tests/warnings/should_compile/StarBinder.hs b/testsuite/tests/ghc-api/annotations/StarBinderAnns.hs
similarity index 100%
copy from testsuite/tests/warnings/should_compile/StarBinder.hs
copy to testsuite/tests/ghc-api/annotations/StarBinderAnns.hs
diff --git a/testsuite/tests/ghc-api/annotations/StarBinderAnns.stdout b/testsuite/tests/ghc-api/annotations/StarBinderAnns.stdout
new file mode 100644
index 0000000..d75f30a
--- /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 8002630..37667e7 100644
--- a/testsuite/tests/ghc-api/annotations/all.T
+++ b/testsuite/tests/ghc-api/annotations/all.T
@@ -59,6 +59,7 @@ test('T13163',      [extra_files(['Test13163.hs']),
                      ignore_stderr], makefile_test, ['T13163'])
 test('T15303',      [extra_files(['Test15303.hs']),
                      ignore_stderr], makefile_test, ['T15303'])
-# Stricter tests from trac #16217 now causes this to fail. Will be fixed for trac #16212
-test('T16212',      [expect_broken(16212),extra_files(['Test16212.hs']),
-                     ignore_stderr], run_command, ['$MAKE -s --no-print-directory T16212'])
+test('T16212',      [extra_files(['Test16212.hs']),
+                     ignore_stderr], makefile_test, ['T16212'])
+test('StarBinderAnns',      [extra_files(['StarBinderAnns.hs']),
+                     ignore_stderr], makefile_test, ['StarBinderAnns'])



More information about the ghc-commits mailing list