EPA: properly capture semicolons between Matches in a FunBind

For the source

    module MatchSemis where
    {
    a 0 = 1;
    a _ = 2;
    }

Make sure that the AddSemiAnn entries for the two trailing semicolons
are attached to the component Match elements.

Closes #19784

2 files changed, 25 insertions, 38 deletions

diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index 79511e9d34..5be9b0e1e3 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -378,26 +378,13 @@ instance ExactPrint HsModule where
         debugM $ "HsModule.AnnWhere coming"
         setLayoutTopLevelP $ markEpAnn' an am_main AnnWhere
 
-    setLayoutTopLevelP $ mapM_ markAddEpAnn (al_open $ am_decls $ anns an)
 
-    -- markOptional GHC.AnnOpenC -- Possible '{'
-    -- markManyOptional GHC.AnnSemi -- possible leading semis
-    -- setContextLevel (Set.singleton TopLevel) 2 $ markListWithLayout imports
-    -- markListWithLayout imports
-    markTopLevelList imports
+    markAnnList' False (am_decls $ anns an) $ do
 
-    -- setContextLevel (Set.singleton TopLevel) 2 $ markListWithLayout decls
-    -- markListWithLayout decls
-    -- setLayoutTopLevelP $ markAnnotated decls
-    markTopLevelList decls
+      markTopLevelList imports
 
-    setLayoutTopLevelP $ mapM_ markAddEpAnn (al_close $ am_decls $ anns an)
-    -- markOptional GHC.AnnCloseC -- Possible '}'
+      markTopLevelList decls
 
-    -- markEOF
-    -- eof <- getEofPos
-    -- debugM $ "eof pos:" ++ show (rs2range eof)
-    -- setLayoutTopLevelP $ printStringAtKw' eof ""
 
 -- ---------------------------------------------------------------------
 
@@ -599,23 +586,22 @@ markKwA kw aa = printStringAtAA aa (keywordToString (G kw))
 
 -- ---------------------------------------------------------------------
 
-markAnnList :: EpAnn AnnList -> EPP () -> EPP ()
-markAnnList EpAnnNotUsed action = action
-markAnnList an@(EpAnn _ ann _) action = do
+markAnnList :: Bool -> EpAnn AnnList -> EPP () -> EPP ()
+markAnnList _ EpAnnNotUsed action = action
+markAnnList reallyTrail (EpAnn _ ann _) action = markAnnList' reallyTrail ann action
+
+markAnnList' :: Bool -> AnnList -> EPP () -> EPP ()
+markAnnList' reallyTrail ann action = do
   p <- getPosP
-  debugM $ "markAnnList : " ++ showPprUnsafe (p, an)
-  markLocatedMAA an al_open
+  debugM $ "markAnnList : " ++ showPprUnsafe (p, ann)
+  mapM_ markAddEpAnn (al_open ann)
+  unless reallyTrail $ markTrailing (al_trailing ann) -- Only makes sense for HsModule.
   action
-  markLocatedMAA an al_close
+  debugM $ "markAnnList: calling markAddEpAnn on:" ++ showPprUnsafe (al_close ann)
+  mapM_ markAddEpAnn (al_close ann)
   debugM $ "markAnnList: calling markTrailing with:" ++ showPprUnsafe (al_trailing ann)
-  markTrailing (al_trailing ann)
-
--- ---------------------------------------------------------------------
+  when reallyTrail $ markTrailing (al_trailing ann) -- normal case
 
--- printTrailingComments :: EPP ()
--- printTrailingComments = do
---   cs <- getUnallocatedComments
---   mapM_ printOneComment cs
 
 -- ---------------------------------------------------------------------
 
@@ -1450,7 +1436,7 @@ instance ExactPrint (HsLocalBinds GhcPs) where
     markAnnotatedWithLayout valbinds
 
   exact (HsIPBinds an bs)
-    = markAnnList an (markLocatedAAL an al_rest AnnWhere >> markAnnotated bs)
+    = markAnnList True an (markLocatedAAL an al_rest AnnWhere >> markAnnotated bs)
   exact (EmptyLocalBinds _) = return ()
 
 
@@ -1947,7 +1933,7 @@ instance ExactPrint (HsExpr GhcPs) where
 
   exact (HsDo an do_or_list_comp stmts) = do
     debugM $ "HsDo"
-    markAnnList an $ exactDo an do_or_list_comp stmts
+    markAnnList True an $ exactDo an do_or_list_comp stmts
 
   exact (ExplicitList an es) = do
     debugM $ "ExplicitList start"
@@ -3458,7 +3444,7 @@ instance ExactPrint (LocatedL [LocatedA (IE GhcPs)]) where
     markLocatedAAL ann al_rest AnnHiding
     p <- getPosP
     debugM $ "LocatedL [LIE:p=" ++ showPprUnsafe p
-    markAnnList ann (markAnnotated ies)
+    markAnnList True ann (markAnnotated ies)
 
 -- AZ:TODO: combine with next instance
 instance ExactPrint (LocatedL [LocatedA (Match GhcPs (LocatedA (HsExpr GhcPs)))]) where
@@ -3488,7 +3474,7 @@ instance ExactPrint (LocatedL [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr Gh
   getAnnotationEntry = entryFromLocatedA
   exact (L (SrcSpanAnn an _) stmts) = do
     debugM $ "LocatedL [ExprLStmt"
-    markAnnList an $ do
+    markAnnList True an $ do
       -- markLocatedMAA an al_open
       case snocView stmts of
         Just (initStmts, ls@(L _ (LastStmt _ _body _ _))) -> do
@@ -3512,13 +3498,13 @@ instance ExactPrint (LocatedL [LocatedA (ConDeclField GhcPs)]) where
   getAnnotationEntry = entryFromLocatedA
   exact (L (SrcSpanAnn an _) fs) = do
     debugM $ "LocatedL [LConDeclField"
-    markAnnList an (mapM_ markAnnotated fs) -- AZ:TODO get rid of mapM_
+    markAnnList True an (mapM_ markAnnotated fs) -- AZ:TODO get rid of mapM_
 
 instance ExactPrint (LocatedL (BF.BooleanFormula (LocatedN RdrName))) where
   getAnnotationEntry = entryFromLocatedA
   exact (L (SrcSpanAnn an _) bf) = do
     debugM $ "LocatedL [LBooleanFormula"
-    markAnnList an (markAnnotated bf)
+    markAnnList True an (markAnnotated bf)
 
 -- ---------------------------------------------------------------------
 -- LocatedL instances end --
@@ -3637,7 +3623,7 @@ instance ExactPrint (Pat GhcPs) where
     markEpAnn an AnnBang
     markAnnotated pat
 
-  exact (ListPat an pats) = markAnnList an (markAnnotated pats)
+  exact (ListPat an pats) = markAnnList True an (markAnnotated pats)
 
   exact (TuplePat an pats boxity) = do
     case boxity of
diff --git a/utils/check-exact/Main.hs b/utils/check-exact/Main.hs
index a9618be40b..a332cc5a8c 100644
--- a/utils/check-exact/Main.hs
+++ b/utils/check-exact/Main.hs
@@ -51,7 +51,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/exactprin
  -- "../../testsuite/tests/ghc-api/exactprint/LocToName.hs" (Just changeLocToName)
  -- "../../testsuite/tests/ghc-api/exactprint/LetIn1.hs" (Just changeLetIn1)
  -- "../../testsuite/tests/ghc-api/exactprint/WhereIn4.hs" (Just changeWhereIn4)
- "../../testsuite/tests/ghc-api/exactprint/AddDecl1.hs" (Just changeAddDecl1)
+ -- "../../testsuite/tests/ghc-api/exactprint/AddDecl1.hs" (Just changeAddDecl1)
  -- "../../testsuite/tests/ghc-api/exactprint/AddDecl2.hs" (Just changeAddDecl2)
  -- "../../testsuite/tests/ghc-api/exactprint/AddDecl3.hs" (Just changeAddDecl3)
  -- "../../testsuite/tests/ghc-api/exactprint/LocalDecls.hs" (Just changeLocalDecls)
@@ -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
@@ -183,6 +183,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/exactprin
  -- "../../testsuite/tests/ghc-api/exactprint/LocalDecls2.expected.hs" Nothing
  -- "../../testsuite/tests/ghc-api/exactprint/WhereIn3a.hs" Nothing
  -- "../../testsuite/tests/ghc-api/exactprint/Windows.hs" Nothing
+ -- "../../testsuite/tests/printer/Test19784.hs" Nothing
 
 -- cloneT does not need a test, function can be retired