From bdcba23143292b737f3766e6cd509f0619bdaab4 Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Sun, 9 May 2021 23:34:47 +0100
Subject: EPA: record annotations for braces in LetStmt

Closes #19814

(cherry picked from commit c3868451e974ee16762a1804d568afea8ed691c7)
---
 compiler/GHC/Parser.y                | 4 +---
 testsuite/tests/printer/Makefile     | 5 +++++
 testsuite/tests/printer/Test19814.hs | 5 +++++
 testsuite/tests/printer/all.T        | 1 +
 utils/check-exact/ExactPrint.hs      | 2 +-
 utils/check-exact/Main.hs            | 3 ++-
 6 files changed, 15 insertions(+), 5 deletions(-)
 create mode 100644 testsuite/tests/printer/Test19814.hs

diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index 6aa75987c1..29d76b0a5a 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -1792,9 +1792,7 @@ binds   ::  { Located (HsLocalBinds GhcPs) }
                                                 -- No type declarations
         : decllist          {% do { val_binds <- cvBindGroup (unLoc $ snd $ unLoc $1)
                                   ; cs <- getCommentsFor (gl $1)
-                                  ; if (isNilOL (unLoc $ snd $ unLoc $1))
-                                    then return (sL1 $1 $ HsValBinds (EpAnn (glR $1) (AnnList (Just $ glR $1) Nothing Nothing [] []) cs) val_binds)
-                                    else return (sL1 $1 $ HsValBinds (EpAnn (glR $1) (fst $ unLoc $1) cs) val_binds) } }
+                                  ; return (sL1 $1 $ HsValBinds (EpAnn (glR $1) (fst $ unLoc $1) cs) val_binds)} }
 
         | '{'            dbinds '}'     {% acs (\cs -> (L (comb3 $1 $2 $3)
                                              $ HsIPBinds (EpAnn (glR $1) (AnnList (Just$ glR $2) (Just $ moc $1) (Just $ mcc $3) [] []) cs) (IPBinds noExtField (reverse $ unLoc $2)))) }
diff --git a/testsuite/tests/printer/Makefile b/testsuite/tests/printer/Makefile
index de71d64b78..4b7e3eb3f6 100644
--- a/testsuite/tests/printer/Makefile
+++ b/testsuite/tests/printer/Makefile
@@ -572,3 +572,8 @@ Test19798:
 Test19813:
 	# $(CHECK_PPR)   $(LIBDIR) Test19813.hs
 	$(CHECK_EXACT) $(LIBDIR) Test19813.hs
+
+.PHONY: Test19814
+Test19814:
+	$(CHECK_PPR)   $(LIBDIR) Test19814.hs
+	$(CHECK_EXACT) $(LIBDIR) Test19814.hs
diff --git a/testsuite/tests/printer/Test19814.hs b/testsuite/tests/printer/Test19814.hs
new file mode 100644
index 0000000000..036a65485c
--- /dev/null
+++ b/testsuite/tests/printer/Test19814.hs
@@ -0,0 +1,5 @@
+module Test19814 where
+
+foo = do { let { }; return (); }
+
+foe = do { let { x = 3 }; return (); }
diff --git a/testsuite/tests/printer/all.T b/testsuite/tests/printer/all.T
index d25cd2bf22..52a1befd37 100644
--- a/testsuite/tests/printer/all.T
+++ b/testsuite/tests/printer/all.T
@@ -130,3 +130,4 @@ test('Test19798', ignore_stderr, makefile_test, ['Test19798'])
 # The exact printing manages the extra semicolons, normal ppr not, so
 # disabled in the Makefile for this test.
 test('Test19813', ignore_stderr, makefile_test, ['Test19813'])
+test('Test19814', ignore_stderr, makefile_test, ['Test19814'])
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index cca7afcf73..0ee82c7f4b 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -1435,7 +1435,7 @@ instance ExactPrint (HsLocalBinds GhcPs) where
         when (not $ isEmptyValBinds valbinds) $ setExtraDP (Just anc)
       _ -> return ()
 
-    markAnnotatedWithLayout valbinds
+    markAnnList True an $ markAnnotatedWithLayout valbinds
 
   exact (HsIPBinds an bs)
     = markAnnList True an (markLocatedAAL an al_rest AnnWhere >> markAnnotated bs)
diff --git a/utils/check-exact/Main.hs b/utils/check-exact/Main.hs
index 78f98d4fe2..fe193c32ec 100644
--- a/utils/check-exact/Main.hs
+++ b/utils/check-exact/Main.hs
@@ -185,7 +185,8 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/exactprin
  -- "../../testsuite/tests/ghc-api/exactprint/WhereIn3a.hs" Nothing
  -- "../../testsuite/tests/ghc-api/exactprint/Windows.hs" Nothing
  -- "../../testsuite/tests/printer/Test19784.hs" Nothing
- "../../testsuite/tests/printer/Test19813.hs" Nothing
+ -- "../../testsuite/tests/printer/Test19813.hs" Nothing
+ "../../testsuite/tests/printer/Test19814.hs" Nothing
 
 -- cloneT does not need a test, function can be retired
 
-- 
cgit v1.2.1