[commit: ghc] ghc-8.0: AnnDotDot missing for Pattern Synonym export (8de4775)

git at git.haskell.org git at git.haskell.org
Sat Jan 2 10:55:05 UTC 2016


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

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/8de477525418eb1f5f475b928a24ed57f1e99e24/ghc

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

commit 8de477525418eb1f5f475b928a24ed57f1e99e24
Author: Alan Zimmerman <alan.zimm at gmail.com>
Date:   Sat Jan 2 12:16:20 2016 +0200

    AnnDotDot missing for Pattern Synonym export
    
    For the following code fragment
    
        {-# LANGUAGE PatternSynonyms #-}
    
        module ExportSyntax ( A(.., NoA), Q(F,..), G(T,..,U)) where
    
    The second and third .. are missing AnnDotdot annotations.
    
    Closes #11332
    
    (cherry picked from commit f5ad1f0301f29e0631d3923dde3d5829b5ef8a53)


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

8de477525418eb1f5f475b928a24ed57f1e99e24
 compiler/parser/Parser.y                           | 21 ++++-----
 testsuite/tests/ghc-api/annotations/Makefile       |  4 ++
 testsuite/tests/ghc-api/annotations/T11332.stdout  | 50 ++++++++++++++++++++++
 .../annotations/Test11332.hs}                      |  2 +-
 testsuite/tests/ghc-api/annotations/all.T          |  1 +
 5 files changed, 67 insertions(+), 11 deletions(-)

diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index ef6c0f5..4732956 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -650,22 +650,23 @@ qcnames :: { ([AddAnn], [Located (Maybe RdrName)]) }
   | qcnames1                      { $1 }
 
 qcnames1 :: { ([AddAnn], [Located (Maybe RdrName)]) }     -- A reversed list
-        :  qcnames1 ',' qcname_ext_w_wildcard  {% case (last (snd $1)) of
+        :  qcnames1 ',' qcname_ext_w_wildcard  {% case (head (snd $1)) of
                                                     l@(L _ Nothing) ->
-                                                      return ([mj AnnComma $2, mj AnnDotdot l]
-                                                              ,($3  : snd $1))
-                                                    l -> (aa (head (snd $1)) (AnnComma, $2) >>
-                                                          return (fst $1, $3 : snd $1)) }
+                                                       return ([mj AnnComma $2, mj AnnDotdot l]
+                                                               ,(snd (unLoc $3)  : snd $1))
+                                                    l -> (ams (head (snd $1)) [mj AnnComma $2] >>
+                                                          return (fst $1 ++ fst (unLoc $3),
+                                                                  snd (unLoc $3) : snd $1)) }
 
 
-        -- Annotations readded in mkImpExpSubSpec
-        |  qcname_ext_w_wildcard                   { ([],[$1])  }
+        -- Annotations re-added in mkImpExpSubSpec
+        |  qcname_ext_w_wildcard                   { (fst (unLoc $1),[snd (unLoc $1)]) }
 
 -- Variable, data constructor or wildcard
 -- or tagged type constructor
-qcname_ext_w_wildcard :: { Located (Maybe RdrName) }
-        :  qcname_ext               { Just `fmap` $1 }
-        |  '..'                     { Nothing <$ $1 }
+qcname_ext_w_wildcard :: { Located ([AddAnn],Located (Maybe RdrName)) }
+        :  qcname_ext               { sL1 $1 ([],Just `fmap` $1) }
+        |  '..'                     { sL1 $1 ([mj AnnDotdot $1], sL1 $1 Nothing) }
 
 qcname_ext :: { Located RdrName }
         :  qcname                   { $1 }
diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile
index 5947455..212f7b0 100644
--- a/testsuite/tests/ghc-api/annotations/Makefile
+++ b/testsuite/tests/ghc-api/annotations/Makefile
@@ -114,3 +114,7 @@ T10276:
 .PHONY: T11321
 T11321:
 	$(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test11321
+
+.PHONY: T11332
+T11332:
+	$(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test11332
diff --git a/testsuite/tests/ghc-api/annotations/T11332.stdout b/testsuite/tests/ghc-api/annotations/T11332.stdout
new file mode 100644
index 0000000..cf1d859
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations/T11332.stdout
@@ -0,0 +1,50 @@
+---Problems (should be empty list)---
+[]
+---Annotations-----------------------
+-- SrcSpan the annotation is attached to, AnnKeywordId,
+--    list of locations the keyword item appears in
+[
+((Test11332.hs:1:1,AnnModule), [Test11332.hs:3:1-6]),
+((Test11332.hs:1:1,AnnWhere), [Test11332.hs:3:52-56]),
+((Test11332.hs:3:18-50,AnnCloseP), [Test11332.hs:3:50]),
+((Test11332.hs:3:18-50,AnnOpenP), [Test11332.hs:3:18]),
+((Test11332.hs:3:20-29,AnnCloseP), [Test11332.hs:3:29]),
+((Test11332.hs:3:20-29,AnnComma), [Test11332.hs:3:24, Test11332.hs:3:30]),
+((Test11332.hs:3:20-29,AnnDotdot), [Test11332.hs:3:22-23]),
+((Test11332.hs:3:20-29,AnnOpenP), [Test11332.hs:3:21]),
+((Test11332.hs:3:32-38,AnnCloseP), [Test11332.hs:3:38]),
+((Test11332.hs:3:32-38,AnnComma), [Test11332.hs:3:39]),
+((Test11332.hs:3:32-38,AnnDotdot), [Test11332.hs:3:36-37]),
+((Test11332.hs:3:32-38,AnnOpenP), [Test11332.hs:3:33]),
+((Test11332.hs:3:34,AnnComma), [Test11332.hs:3:35]),
+((Test11332.hs:3:41-49,AnnCloseP), [Test11332.hs:3:49]),
+((Test11332.hs:3:41-49,AnnComma), [Test11332.hs:3:47]),
+((Test11332.hs:3:41-49,AnnDotdot), [Test11332.hs:3:45-46]),
+((Test11332.hs:3:41-49,AnnOpenP), [Test11332.hs:3:42]),
+((Test11332.hs:3:43,AnnComma), [Test11332.hs:3:44]),
+((Test11332.hs:5:1-14,AnnData), [Test11332.hs:5:1-4]),
+((Test11332.hs:5:1-14,AnnEqual), [Test11332.hs:5:8]),
+((Test11332.hs:5:1-14,AnnSemi), [Test11332.hs:7:1]),
+((Test11332.hs:5:10,AnnVbar), [Test11332.hs:5:12]),
+((Test11332.hs:7:1-15,AnnEqual), [Test11332.hs:7:13]),
+((Test11332.hs:7:1-15,AnnPattern), [Test11332.hs:7:1-7]),
+((Test11332.hs:7:1-15,AnnSemi), [Test11332.hs:9:1]),
+((Test11332.hs:9:1-14,AnnData), [Test11332.hs:9:1-4]),
+((Test11332.hs:9:1-14,AnnEqual), [Test11332.hs:9:10]),
+((Test11332.hs:9:1-14,AnnSemi), [Test11332.hs:11:1]),
+((Test11332.hs:11:1-17,AnnEqual), [Test11332.hs:11:13]),
+((Test11332.hs:11:1-17,AnnPattern), [Test11332.hs:11:1-7]),
+((Test11332.hs:11:1-17,AnnSemi), [Test11332.hs:13:1]),
+((Test11332.hs:13:1-14,AnnData), [Test11332.hs:13:1-4]),
+((Test11332.hs:13:1-14,AnnEqual), [Test11332.hs:13:8]),
+((Test11332.hs:13:1-14,AnnSemi), [Test11332.hs:15:1]),
+((Test11332.hs:13:10,AnnVbar), [Test11332.hs:13:12]),
+((Test11332.hs:15:1-13,AnnEqual), [Test11332.hs:15:11]),
+((Test11332.hs:15:1-13,AnnPattern), [Test11332.hs:15:1-7]),
+((Test11332.hs:15:1-13,AnnSemi), [Test11332.hs:17:1]),
+((Test11332.hs:17:1-13,AnnEqual), [Test11332.hs:17:11]),
+((Test11332.hs:17:1-13,AnnPattern), [Test11332.hs:17:1-7]),
+((Test11332.hs:17:1-13,AnnSemi), [Test11332.hs:18:1]),
+((<no location info>,AnnEofPos), [Test11332.hs:18:1])
+]
+
diff --git a/testsuite/tests/patsyn/should_compile/ExportSyntax.hs b/testsuite/tests/ghc-api/annotations/Test11332.hs
similarity index 71%
copy from testsuite/tests/patsyn/should_compile/ExportSyntax.hs
copy to testsuite/tests/ghc-api/annotations/Test11332.hs
index 7c50cf4..41e84b0 100644
--- a/testsuite/tests/patsyn/should_compile/ExportSyntax.hs
+++ b/testsuite/tests/ghc-api/annotations/Test11332.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE PatternSynonyms #-}
 
-module ExportSyntax ( A(.., NoA), Q(F,..), G(T,..,U)) where
+module Test11332 ( A(.., NoA), Q(F,..), G(T,..,U)) where
 
 data A = A | B
 
diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T
index ad6682e..a2750ff 100644
--- a/testsuite/tests/ghc-api/annotations/all.T
+++ b/testsuite/tests/ghc-api/annotations/all.T
@@ -22,3 +22,4 @@ test('T11018',      normal, run_command, ['$MAKE -s --no-print-directory T11018'
 test('bundle-export', normal, run_command, ['$MAKE -s --no-print-directory bundle-export'])
 test('T10276',      normal, run_command, ['$MAKE -s --no-print-directory T10276'])
 test('T11321',      normal, run_command, ['$MAKE -s --no-print-directory T11321'])
+test('T11332',      normal, run_command, ['$MAKE -s --no-print-directory T11332'])



More information about the ghc-commits mailing list