[commit: ghc] master: AnnDotDot missing for Pattern Synonym export (f5ad1f0)
git at git.haskell.org
git at git.haskell.org
Sat Jan 2 10:18:07 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/f5ad1f0301f29e0631d3923dde3d5829b5ef8a53/ghc
>---------------------------------------------------------------
commit f5ad1f0301f29e0631d3923dde3d5829b5ef8a53
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
>---------------------------------------------------------------
f5ad1f0301f29e0631d3923dde3d5829b5ef8a53
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