Demonstrates segfault in ghciwip/az/T21355-exactprint-update-segfault

In the utils/check-exact directory do

../../_build/stage1/bin/ghc --interactive
:l Main.hs
:main

It segfaults.

Do

../../_build/stage1/bin/ghc --interactive
:set -fobject-code
:l Main.hs
:main

It runs successfully (logging a lot of stuff).

The two logs are different, the one just before the segfault returns
junk for an AddEpAnn value.
See https://gist.github.com/alanz/9b944a59dbaa04f5d502fb5244d83270
for some detail

3 files changed, 14 insertions, 7 deletions

diff --git a/utils/check-exact/.ghci b/utils/check-exact/.ghci
index 588f8b7264..f1c0f9d503 100644
--- a/utils/check-exact/.ghci
+++ b/utils/check-exact/.ghci
@@ -1,4 +1,3 @@
 :set -package ghc
-:set -package mtl
-:set -i./src
 :set -Wall
+-- :set -fobject-code
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index e1d7ca57b3..d5f6b615d3 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -512,6 +512,8 @@ printStringAtRsC capture pa str = do
     NoCaptureComments -> return []
   debugM $ "printStringAtRsC:cs'=" ++ show cs'
   debugM $ "printStringAtRsC:p'=" ++ showAst p'
+  debugM $ "printStringAtRsC: (EpaDelta p' [])=" ++ showAst (EpaDelta p' [])
+  debugM $ "printStringAtRsC: (EpaDelta p' (map comment2LEpaComment cs'))=" ++ showAst (EpaDelta p' (map comment2LEpaComment cs'))
   return (EpaDelta p' (map comment2LEpaComment cs'))
 
 printStringAtRs' :: (Monad m, Monoid w) => RealSrcSpan -> String -> EP w m ()
@@ -550,7 +552,10 @@ printStringAtAAL (EpAnn anc an cs) l str = do
 
 printStringAtAAC :: (Monad m, Monoid w)
   => CaptureComments -> EpaLocation -> String -> EP w m EpaLocation
-printStringAtAAC capture (EpaSpan r) s = printStringAtRsC capture r s
+printStringAtAAC capture (EpaSpan r) s = do
+  ret <- printStringAtRsC capture r s
+  debugM $ "printStringAtAAC: (EpaSpan r,s,ret)=" ++ showAst (EpaSpan r,s,ret)
+  return ret
 printStringAtAAC capture (EpaDelta d cs) s = do
   debugM $ "printStringAtAAC: EpaDelta"
   mapM_ (printOneComment . tokComment) cs
@@ -1194,7 +1199,10 @@ markKwA kw aa = markKwAC CaptureComments kw aa
 
 markKwAC :: (Monad m, Monoid w)
   => CaptureComments -> AnnKeywordId -> EpaLocation -> EP w m EpaLocation
-markKwAC capture kw aa = printStringAtAAC capture aa (keywordToString kw)
+markKwAC capture kw aa = do
+  r <- printStringAtAAC capture aa (keywordToString kw)
+  debugM $ "markKwAC: r=" ++ showAst r
+  return r
 
 -- | Print a keyword encoded in a 'TrailingAnn'
 markKwT :: (Monad m, Monoid w) => TrailingAnn -> EP w m TrailingAnn
@@ -4316,7 +4324,7 @@ instance ExactPrint (ConDecl GhcPs) where
     doc' <- mapM markAnnotated doc
     cons' <- mapM markAnnotated cons
     dcol' <- markUniToken dcol
-    an1 <- annotationsToComments an0 lidl  [AnnOpenP, AnnCloseP]
+    an1 <- annotationsToComments an lidl  [AnnOpenP, AnnCloseP]
 
     -- Work around https://gitlab.haskell.org/ghc/ghc/-/issues/20558
     bndrs' <- case bndrs of
diff --git a/utils/check-exact/Main.hs b/utils/check-exact/Main.hs
index b8637b083b..24bf82a2c4 100644
--- a/utils/check-exact/Main.hs
+++ b/utils/check-exact/Main.hs
@@ -36,7 +36,7 @@ import GHC.Data.FastString
 -- ---------------------------------------------------------------------
 
 _tt :: IO ()
-_tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/lib"
+_tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/lib/"
 -- _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/exactprint/_build/stage1/lib"
 -- _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/epw/_build/stage1/lib"
 
@@ -81,7 +81,6 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/
  -- "../../testsuite/tests/ghc-api/exactprint/RmTypeSig2.hs" (Just rmTypeSig2)
  -- "../../testsuite/tests/ghc-api/exactprint/AddHiding1.hs" (Just addHiding1)
  -- "../../testsuite/tests/ghc-api/exactprint/AddHiding2.hs" (Just addHiding2)
-
  "../../testsuite/tests/printer/Ppr001.hs" Nothing
  -- "../../testsuite/tests/ghc-api/annotations/CommentsTest.hs" Nothing
  -- "../../testsuite/tests/hiefile/should_compile/Constructors.hs" Nothing
@@ -268,6 +267,7 @@ main :: IO()
 main = do
   args <- getArgs
   case args of
+   [] -> _tt
    [libdir,fileName] -> testOneFile changers libdir fileName Nothing
    [libdir,fileName,changerStr] -> do
      case lookup changerStr changers of