summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/GHC/Parser.y10
-rw-r--r--compiler/GHC/Parser/Annotation.hs4
-rw-r--r--testsuite/tests/printer/Makefile5
-rw-r--r--testsuite/tests/printer/Test19798.hs6
-rw-r--r--testsuite/tests/printer/all.T3
-rw-r--r--utils/check-exact/ExactPrint.hs1
-rw-r--r--utils/check-exact/Main.hs3
7 files changed, 24 insertions, 8 deletions
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index da5572dcef..483fb06e97 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -3289,9 +3289,9 @@ apats :: { [LPat GhcPs] }
stmtlist :: { forall b. DisambECP b => PV (LocatedL [LocatedA (Stmt GhcPs (LocatedA b))]) }
: '{' stmts '}' { $2 >>= \ $2 -> amsrl
- (sLL $1 $> (reverse $ snd $ unLoc $2)) (AnnList (Just $ glR $2) (Just $ moc $1) (Just $ mcc $3) [] (fst $ unLoc $2)) } -- AZ:performance of reverse?
+ (sLL $1 $> (reverse $ snd $ unLoc $2)) (AnnList (Just $ glR $2) (Just $ moc $1) (Just $ mcc $3) (fst $ unLoc $2) []) } -- AZ:performance of reverse?
| vocurly stmts close { $2 >>= \ $2 -> amsrl
- (L (gl $2) (reverse $ snd $ unLoc $2)) (AnnList (Just $ glR $2) Nothing Nothing [] (fst $ unLoc $2)) }
+ (L (gl $2) (reverse $ snd $ unLoc $2)) (AnnList (Just $ glR $2) Nothing Nothing (fst $ unLoc $2) []) }
-- do { ;; s ; s ; ; s ;; }
-- The last Stmt should be an expression, but that's hard to enforce
@@ -3299,11 +3299,11 @@ stmtlist :: { forall b. DisambECP b => PV (LocatedL [LocatedA (Stmt GhcPs (Locat
-- So we use BodyStmts throughout, and switch the last one over
-- in ParseUtils.checkDo instead
-stmts :: { forall b. DisambECP b => PV (Located ([TrailingAnn],[LStmt GhcPs (LocatedA b)])) }
+stmts :: { forall b. DisambECP b => PV (Located ([AddEpAnn],[LStmt GhcPs (LocatedA b)])) }
: stmts ';' stmt { $1 >>= \ $1 ->
$3 >>= \ ($3 :: LStmt GhcPs (LocatedA b)) ->
case (snd $ unLoc $1) of
- [] -> return (sLL $1 (reLoc $>) ((msemi $2) ++ (fst $ unLoc $1)
+ [] -> return (sLL $1 (reLoc $>) ((mj AnnSemi $2) : (fst $ unLoc $1)
,$3 : (snd $ unLoc $1)))
(h:t) -> do
{ h' <- addTrailingSemiA h (gl $2)
@@ -3311,7 +3311,7 @@ stmts :: { forall b. DisambECP b => PV (Located ([TrailingAnn],[LStmt GhcPs (Loc
| stmts ';' { $1 >>= \ $1 ->
case (snd $ unLoc $1) of
- [] -> return (sLL $1 $> ((msemi $2) ++ (fst $ unLoc $1),snd $ unLoc $1))
+ [] -> return (sLL $1 $> ((mj AnnSemi $2) : (fst $ unLoc $1),snd $ unLoc $1))
(h:t) -> do
{ h' <- addTrailingSemiA h (gl $2)
; return $ sL1 $1 (fst $ unLoc $1,h':t) }}
diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs
index 8dc12555a0..8d47c699ba 100644
--- a/compiler/GHC/Parser/Annotation.hs
+++ b/compiler/GHC/Parser/Annotation.hs
@@ -689,7 +689,9 @@ data AnnList
al_open :: Maybe AddEpAnn,
al_close :: Maybe AddEpAnn,
al_rest :: [AddEpAnn], -- ^ context, such as 'where' keyword
- al_trailing :: [TrailingAnn]
+ al_trailing :: [TrailingAnn] -- ^ items appearing after the
+ -- list, such as '=>' for a
+ -- context
} deriving (Data,Eq)
-- ---------------------------------------------------------------------
diff --git a/testsuite/tests/printer/Makefile b/testsuite/tests/printer/Makefile
index 3bd736b7a8..fe95e5a237 100644
--- a/testsuite/tests/printer/Makefile
+++ b/testsuite/tests/printer/Makefile
@@ -562,3 +562,8 @@ InTreeAnnotations1:
Test19784:
$(CHECK_PPR) $(LIBDIR) Test19784.hs
$(CHECK_EXACT) $(LIBDIR) Test19784.hs
+
+.PHONY: Test19798
+Test19798:
+ $(CHECK_PPR) $(LIBDIR) Test19798.hs
+ $(CHECK_EXACT) $(LIBDIR) Test19798.hs
diff --git a/testsuite/tests/printer/Test19798.hs b/testsuite/tests/printer/Test19798.hs
new file mode 100644
index 0000000000..0b9e5162f1
--- /dev/null
+++ b/testsuite/tests/printer/Test19798.hs
@@ -0,0 +1,6 @@
+module Test19798 where
+
+blah = do {
+ ; print "a"
+ ; print "b"
+ }
diff --git a/testsuite/tests/printer/all.T b/testsuite/tests/printer/all.T
index 04d6d33acc..d73e82ad2a 100644
--- a/testsuite/tests/printer/all.T
+++ b/testsuite/tests/printer/all.T
@@ -124,4 +124,5 @@ test('PprRecordDotSyntaxA', ignore_stderr, makefile_test, ['PprRecordDotSyntaxA'
test('CommentsTest', ignore_stderr, makefile_test, ['CommentsTest'])
test('InTreeAnnotations1', ignore_stderr, makefile_test, ['InTreeAnnotations1'])
-test('Test19784', ignore_stderr, makefile_test, ['Test19784']) \ No newline at end of file
+test('Test19784', ignore_stderr, makefile_test, ['Test19784'])
+test('Test19798', ignore_stderr, makefile_test, ['Test19798'])
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index 4c8f3f27ac..3680405a0a 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -596,6 +596,7 @@ markAnnList' reallyTrail ann action = do
debugM $ "markAnnList : " ++ showPprUnsafe (p, ann)
mapM_ markAddEpAnn (al_open ann)
unless reallyTrail $ markTrailing (al_trailing ann) -- Only makes sense for HsModule.
+ mark (sort $ al_rest ann) AnnSemi
action
debugM $ "markAnnList: calling markAddEpAnn on:" ++ showPprUnsafe (al_close ann)
mapM_ markAddEpAnn (al_close ann)
diff --git a/utils/check-exact/Main.hs b/utils/check-exact/Main.hs
index a332cc5a8c..27a24f1804 100644
--- a/utils/check-exact/Main.hs
+++ b/utils/check-exact/Main.hs
@@ -114,7 +114,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/exactprin
-- "../../testsuite/tests/printer/Ppr026.hs" Nothing
-- "../../testsuite/tests/printer/Ppr027.hs" Nothing
-- "../../testsuite/tests/printer/Ppr028.hs" Nothing
- "../../testsuite/tests/printer/Ppr029.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr029.hs" Nothing
-- "../../testsuite/tests/printer/Ppr030.hs" Nothing
-- "../../testsuite/tests/printer/Ppr031.hs" Nothing
-- "../../testsuite/tests/printer/Ppr032.hs" Nothing
@@ -173,6 +173,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/exactprin
-- "../../testsuite/tests/printer/Test16236.hs" Nothing
-- "../../testsuite/tests/printer/Test17519.hs" Nothing
-- "../../testsuite/tests/printer/InTreeAnnotations1.hs" Nothing
+ "../../testsuite/tests/printer/Test19798.hs" Nothing
-- "../../testsuite/tests/qualifieddo/should_compile/qdocompile001.hs" Nothing
-- "../../testsuite/tests/typecheck/should_fail/StrictBinds.hs" Nothing
View Lorry Controller Status