EPA: properly capture leading semicolons in statement listswip/az/exactprint-19798

For the fragment

    blah = do {
     ; print "a"
     ; print "b"
     }

capture the leading semicolon before 'print "a"' in
'al_rest' in AnnList instead of in 'al_trailing'.

Closes #19798

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