[commit: ghc] wip/7.10-api-annots: API Annotations : ExprWithTySig processing discards annotated spans (56e5b75)
git at git.haskell.org
git at git.haskell.org
Fri May 8 17:02:11 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/7.10-api-annots
Link : http://ghc.haskell.org/trac/ghc/changeset/56e5b751588ca6ffa7038b9ac2631c11363dc791/ghc
>---------------------------------------------------------------
commit 56e5b751588ca6ffa7038b9ac2631c11363dc791
Author: Alan Zimmerman <alan.zimm at gmail.com>
Date: Tue Apr 14 07:32:40 2015 -0500
API Annotations : ExprWithTySig processing discards annotated spans
In RdrHsSyn.checkAPat the processing for ExprWithTySig is defined as
ExprWithTySig e t _ -> do e <- checkLPat msg e
-- Pattern signatures are parsed as sigtypes,
-- but they aren't explicit forall points. Hence
-- we have to remove the implicit forall here.
let t' = case t of
L _ (HsForAllTy Implicit _ _
(L _ []) ty) -> ty
other -> other
return (SigPatIn e (mkHsWithBndrs t'))
The t' variable ends up losing its original SrcSpan in the first case
branch. This results in annotations becoming detached from the AST.
Reviewed By: austin
Differential Revision: https://phabricator.haskell.org/D823
GHC Trac Issues: #10255
(cherry picked from commit 8dc294487fdaf102349c373c7db4796693573310)
Conflicts:
testsuite/tests/ghc-api/annotations/Makefile
>---------------------------------------------------------------
56e5b751588ca6ffa7038b9ac2631c11363dc791
compiler/parser/RdrHsSyn.hs | 3 +-
testsuite/tests/ghc-api/annotations/.gitignore | 1 +
testsuite/tests/ghc-api/annotations/Makefile | 7 ++++-
testsuite/tests/ghc-api/annotations/T10255.stderr | 3 ++
testsuite/tests/ghc-api/annotations/T10255.stdout | 36 ++++++++++++++++++++++
testsuite/tests/ghc-api/annotations/Test10255.hs | 7 +++++
testsuite/tests/ghc-api/annotations/all.T | 1 +
.../annotations/{exampleTest.hs => t10255.hs} | 8 +----
8 files changed, 57 insertions(+), 9 deletions(-)
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index 52462f0..228f3c5 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -849,7 +849,8 @@ checkAPat msg loc e0 = do
L _ (HsForAllTy Implicit _ _
(L _ []) ty) -> ty
other -> other
- return (SigPatIn e (mkHsWithBndrs t'))
+ return (SigPatIn e (mkHsWithBndrs
+ (L (getLoc t) (HsParTy t'))))
-- n+k patterns
OpApp (L nloc (HsVar n)) (L _ (HsVar plus)) _
diff --git a/testsuite/tests/ghc-api/annotations/.gitignore b/testsuite/tests/ghc-api/annotations/.gitignore
index ba31dbb..d142368 100644
--- a/testsuite/tests/ghc-api/annotations/.gitignore
+++ b/testsuite/tests/ghc-api/annotations/.gitignore
@@ -3,6 +3,7 @@ parseTree
comments
exampleTest
listcomps
+t10255
*.hi
*.o
*.run.*
diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile
index 6f0ef46..08a6d49 100644
--- a/testsuite/tests/ghc-api/annotations/Makefile
+++ b/testsuite/tests/ghc-api/annotations/Makefile
@@ -31,4 +31,9 @@ listcomps:
'$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc listcomps
./listcomps "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`"
-.PHONY: clean
+t10255:
+ rm -f t10255.o t10255.hi
+ '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t10255
+ ./t10255 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`"
+
+.PHONY: clean annotations parseTree comments exampleTest listcomps t10255
diff --git a/testsuite/tests/ghc-api/annotations/T10255.stderr b/testsuite/tests/ghc-api/annotations/T10255.stderr
new file mode 100644
index 0000000..be1a915
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations/T10255.stderr
@@ -0,0 +1,3 @@
+
+Test10255.hs:1:14: Warning:
+ -XPatternSignatures is deprecated: use -XScopedTypeVariables or pragma {-# LANGUAGE ScopedTypeVariables #-} instead
diff --git a/testsuite/tests/ghc-api/annotations/T10255.stdout b/testsuite/tests/ghc-api/annotations/T10255.stdout
new file mode 100644
index 0000000..099ef54
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations/T10255.stdout
@@ -0,0 +1,36 @@
+---Problems---------------------
+[
+(AK <no location info> AnnEofPos = [Test10255.hs:8:1])
+]
+
+--------------------------------
+[
+(AK Test10255.hs:1:1 AnnModule = [Test10255.hs:2:1-6])
+
+(AK Test10255.hs:1:1 AnnWhere = [Test10255.hs:2:18-22])
+
+(AK Test10255.hs:4:1-17 AnnImport = [Test10255.hs:4:1-6])
+
+(AK Test10255.hs:4:1-17 AnnSemi = [Test10255.hs:6:1])
+
+(AK Test10255.hs:(6,1)-(7,11) AnnEqual = [Test10255.hs:6:29])
+
+(AK Test10255.hs:(6,1)-(7,11) AnnFunId = [Test10255.hs:6:1-3])
+
+(AK Test10255.hs:(6,1)-(7,11) AnnSemi = [Test10255.hs:8:1])
+
+(AK Test10255.hs:6:5-27 AnnCloseP = [Test10255.hs:6:27])
+
+(AK Test10255.hs:6:5-27 AnnOpenP = [Test10255.hs:6:5])
+
+(AK Test10255.hs:6:6-26 AnnDcolon = [Test10255.hs:6:8-9])
+
+(AK Test10255.hs:6:11-26 AnnCloseP = [Test10255.hs:6:26])
+
+(AK Test10255.hs:6:11-26 AnnOpenP = [Test10255.hs:6:11])
+
+(AK Test10255.hs:6:12-25 AnnRarrow = [Test10255.hs:6:20-21])
+
+(AK <no location info> AnnEofPos = [Test10255.hs:8:1])
+]
+
diff --git a/testsuite/tests/ghc-api/annotations/Test10255.hs b/testsuite/tests/ghc-api/annotations/Test10255.hs
new file mode 100644
index 0000000..386452d
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations/Test10255.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE PatternSignatures #-}
+module Test10255 where
+
+import Data.Maybe
+
+fob (f :: (Maybe t -> Int)) =
+ undefined
diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T
index 9dadf7a..ed888a3 100644
--- a/testsuite/tests/ghc-api/annotations/all.T
+++ b/testsuite/tests/ghc-api/annotations/all.T
@@ -3,3 +3,4 @@ test('parseTree', normal, run_command, ['$MAKE -s --no-print-directory parseTr
test('comments', normal, run_command, ['$MAKE -s --no-print-directory comments'])
test('exampleTest', normal, run_command, ['$MAKE -s --no-print-directory exampleTest'])
test('listcomps', normal, run_command, ['$MAKE -s --no-print-directory listcomps'])
+test('T10255', normal, run_command, ['$MAKE -s --no-print-directory t10255'])
diff --git a/testsuite/tests/ghc-api/annotations/exampleTest.hs b/testsuite/tests/ghc-api/annotations/t10255.hs
similarity index 91%
copy from testsuite/tests/ghc-api/annotations/exampleTest.hs
copy to testsuite/tests/ghc-api/annotations/t10255.hs
index 0b6c224..49c68e2 100644
--- a/testsuite/tests/ghc-api/annotations/exampleTest.hs
+++ b/testsuite/tests/ghc-api/annotations/t10255.hs
@@ -24,7 +24,7 @@ import Data.Dynamic ( fromDynamic,Dynamic )
main::IO()
main = do
[libdir] <- getArgs
- testOneFile libdir "AnnotationTuple"
+ testOneFile libdir "Test10255"
testOneFile libdir fileName = do
((anns,cs),p) <- runGhc (Just libdir) $ do
@@ -37,16 +37,10 @@ testOneFile libdir fileName = do
load LoadAllTargets
modSum <- getModSummary mn
p <- parseModule modSum
- t <- typecheckModule p
- d <- desugarModule t
- l <- loadModule d
- let ts=typecheckedSource l
- r =renamedSource l
return (pm_annotations p,p)
let spans = Set.fromList $ getAllSrcSpans (pm_parsed_source p)
- -- putStrLn (pp spans)
problems = filter (\(s,a) -> not (Set.member s spans))
$ getAnnSrcSpans (anns,cs)
putStrLn "---Problems---------------------"
More information about the ghc-commits
mailing list