AnnDotDot missing for Pattern Synonym export
authorAlan Zimmerman <alan.zimm@gmail.com>
Sat, 2 Jan 2016 10:16:20 +0000 (12:16 +0200)
committerHerbert Valerio Riedel <hvr@gnu.org>
Sat, 2 Jan 2016 10:55:45 +0000 (11:55 +0100)
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)

compiler/parser/Parser.y
testsuite/tests/ghc-api/annotations/Makefile
testsuite/tests/ghc-api/annotations/T11332.stdout [new file with mode: 0644]
testsuite/tests/ghc-api/annotations/Test11332.hs [new file with mode: 0644]
testsuite/tests/ghc-api/annotations/all.T

index ef6c0f5..4732956 100644 (file)
@@ -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 }
index 5947455..212f7b0 100644 (file)
@@ -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 (file)
index 0000000..cf1d859
--- /dev/null
@@ -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/ghc-api/annotations/Test11332.hs b/testsuite/tests/ghc-api/annotations/Test11332.hs
new file mode 100644 (file)
index 0000000..41e84b0
--- /dev/null
@@ -0,0 +1,17 @@
+{-# LANGUAGE PatternSynonyms #-}
+
+module Test11332 ( A(.., NoA), Q(F,..), G(T,..,U)) where
+
+data A = A | B
+
+pattern NoA = B
+
+data Q a = Q a
+
+pattern F a = Q a
+
+data G = G | H
+
+pattern T = G
+
+pattern U = H
index ad6682e..a2750ff 100644 (file)
@@ -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'])