13 files changed, 170 insertions, 7 deletions
diff --git a/testsuite/tests/plugins/Makefile b/testsuite/tests/plugins/Makefile
index 7ee0ccbfb7..442e69cd92 100644
--- a/testsuite/tests/plugins/Makefile
+++ b/testsuite/tests/plugins/Makefile
@@ -182,3 +182,10 @@ plugins-order-pragma:
 	"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins-order-pragma.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin ImpurePlugin
 	./plugins-order-pragma
 
+.PHONY: T20803a
+T20803a:
+	"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 T20803a.hs -package-db T20803-plugin/pkg.T20803a/local.package.conf
+
+.PHONY: T20803b
+T20803b:
+	"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 T20803b.hs -package-db T20803-plugin/pkg.T20803b/local.package.conf
diff --git a/testsuite/tests/plugins/T20803-plugin/AddErrorPlugin.hs b/testsuite/tests/plugins/T20803-plugin/AddErrorPlugin.hs
new file mode 100644
index 0000000000..e055204acf
--- /dev/null
+++ b/testsuite/tests/plugins/T20803-plugin/AddErrorPlugin.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE GADTs #-}
+
+module AddErrorPlugin where
+
+import GHC.Plugins
+import GHC.Types.Error
+import GHC.Hs
+import GHC.Data.Bag
+import GHC.Parser.Errors.Types
+
+import System.IO
+
+-- Tests whether it's possible to add a parse error
+plugin :: Plugin
+plugin = defaultPlugin {parsedResultAction = parsedAction}
+
+parsedAction :: [CommandLineOption] -> ModSummary -> HsParsedModule
+             -> (Messages PsWarning, Messages PsError)
+             -> Hsc (HsParsedModule, (Messages PsWarning, Messages PsError))
+parsedAction _ _ pm (warns, _) = do
+  liftIO $ putStrLn "parsePlugin"
+  -- TODO: Remove #20791
+  liftIO $ hFlush stdout
+  pure (pm, (warns, mkMessages $ unitBag err))
+  where
+    err = MsgEnvelope
+      { errMsgSpan = UnhelpfulSpan UnhelpfulNoLocationInfo
+      , errMsgContext = alwaysQualify
+      , errMsgDiagnostic = PsErrEmptyLambda
+      , errMsgSeverity = SevError
+      }
diff --git a/testsuite/tests/plugins/T20803-plugin/FixErrorsPlugin.hs b/testsuite/tests/plugins/T20803-plugin/FixErrorsPlugin.hs
new file mode 100644
index 0000000000..1cf44edd8a
--- /dev/null
+++ b/testsuite/tests/plugins/T20803-plugin/FixErrorsPlugin.hs
@@ -0,0 +1,51 @@
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE GADTs #-}
+
+module FixErrorsPlugin where
+
+import GHC.Plugins
+import GHC.Types.Error
+import GHC.Hs
+import GHC.Data.Bag
+import GHC.Parser.Errors.Types
+
+import System.IO
+import Data.Type.Equality as Eq
+import Data.Data
+import Data.Maybe
+
+-- Tests whether it's possible to remove a parse error and fix the erroneous AST
+plugin :: Plugin
+plugin = defaultPlugin {parsedResultAction = parsedAction}
+
+-- Replace every hole (and other unbound vars) with the given expression
+replaceHoles :: forall a . Data a => HsExpr GhcPs -> a -> a
+replaceHoles new = gmapT \case
+  (d :: d) -> replaceHoles new d `fromMaybe` tryHole
+    where
+      tryHole :: Maybe d
+      tryHole = eqT @d @(HsExpr GhcPs) >>= \case
+        Eq.Refl | HsUnboundVar _ _ <- d -> Just new
+        _                               -> Nothing
+
+parsedAction :: [CommandLineOption] -> ModSummary -> HsParsedModule
+             -> (Messages PsWarning, Messages PsError)
+             -> Hsc (HsParsedModule, (Messages PsWarning, Messages PsError))
+parsedAction _ _ (HsParsedModule lmod srcFiles) (warns, errs) = do
+  liftIO $ putStrLn "parsePlugin"
+  liftIO $ putStrLn $ showPprUnsafe newModule
+  -- TODO: Remove #20791
+  liftIO $ hFlush stdout
+  pure (HsParsedModule newModule srcFiles, (warns, otherErrs))
+
+  where
+    PsErrBangPatWithoutSpace (L _ holeExpr) = errMsgDiagnostic noSpaceBang
+    (bagToList -> [noSpaceBang], mkMessages -> otherErrs) =
+      partitionBag (isNoSpaceBang . errMsgDiagnostic) . getMessages $ errs
+
+    isNoSpaceBang (PsErrBangPatWithoutSpace _) = True
+    isNoSpaceBang _ = False
+
+    newModule = replaceHoles holeExpr <$> lmod
diff --git a/testsuite/tests/plugins/T20803-plugin/Makefile b/testsuite/tests/plugins/T20803-plugin/Makefile
new file mode 100644
index 0000000000..9d5468b812
--- /dev/null
+++ b/testsuite/tests/plugins/T20803-plugin/Makefile
@@ -0,0 +1,20 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+clean.%:
+	rm -rf pkg.$*
+
+HERE := $(abspath .)
+$(eval $(call canonicalise,HERE))
+
+package.%:
+	$(MAKE) -s --no-print-directory clean.$*
+	mkdir pkg.$*
+	"$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs
+
+	"$(GHC_PKG)" init pkg.$*/local.package.conf
+
+	pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling)
+	pkg.$*/setup build     --distdir pkg.$*/dist -v0
+	pkg.$*/setup install   --distdir pkg.$*/dist -v0
diff --git a/testsuite/tests/plugins/T20803-plugin/Setup.hs b/testsuite/tests/plugins/T20803-plugin/Setup.hs
new file mode 100644
index 0000000000..e8ef27dbba
--- /dev/null
+++ b/testsuite/tests/plugins/T20803-plugin/Setup.hs
@@ -0,0 +1,3 @@
+import Distribution.Simple
+
+main = defaultMain
diff --git a/testsuite/tests/plugins/T20803-plugin/T20803-plugin.cabal b/testsuite/tests/plugins/T20803-plugin/T20803-plugin.cabal
new file mode 100644
index 0000000000..48dc1fa489
--- /dev/null
+++ b/testsuite/tests/plugins/T20803-plugin/T20803-plugin.cabal
@@ -0,0 +1,13 @@
+Name:           T20803-plugin
+Version:        0.1
+Synopsis:       For testing
+Build-Type:     Simple
+Cabal-Version:  >= 1.10
+
+Library
+    Extensions:     CPP
+    Default-language: GHC2021
+    Build-Depends: base, ghc
+    Exposed-Modules:
+        FixErrorsPlugin
+        AddErrorPlugin
diff --git a/testsuite/tests/plugins/T20803a.hs b/testsuite/tests/plugins/T20803a.hs
new file mode 100644
index 0000000000..aa1afb8e32
--- /dev/null
+++ b/testsuite/tests/plugins/T20803a.hs
@@ -0,0 +1,6 @@
+module Main where
+
+main = do
+  putStrLn "Program Started"
+  putStrLn !"message"
+  putStrLn "Program Ended"
diff --git a/testsuite/tests/plugins/T20803a.stderr b/testsuite/tests/plugins/T20803a.stderr
new file mode 100644
index 0000000000..828a882f24
--- /dev/null
+++ b/testsuite/tests/plugins/T20803a.stderr
@@ -0,0 +1,6 @@
+parsePlugin
+module Main where
+main
+  = do putStrLn "Program Started"
+       putStrLn "message"
+       putStrLn "Program Ended"
diff --git a/testsuite/tests/plugins/T20803b.hs b/testsuite/tests/plugins/T20803b.hs
new file mode 100644
index 0000000000..46d214c2e6
--- /dev/null
+++ b/testsuite/tests/plugins/T20803b.hs
@@ -0,0 +1,6 @@
+module Main where
+
+main = do
+  putStrLn "Program Started"
+  putStrLn "message"
+  putStrLn "Program Ended"
diff --git a/testsuite/tests/plugins/T20803b.stderr b/testsuite/tests/plugins/T20803b.stderr
new file mode 100644
index 0000000000..3bb08f7756
--- /dev/null
+++ b/testsuite/tests/plugins/T20803b.stderr
@@ -0,0 +1,3 @@
+parsePlugin
+
+<no location info>: A lambda requires at least one parameter
diff --git a/testsuite/tests/plugins/all.T b/testsuite/tests/plugins/all.T
index 3fda3755ae..d2681ac658 100644
--- a/testsuite/tests/plugins/all.T
+++ b/testsuite/tests/plugins/all.T
@@ -277,3 +277,15 @@ test('plugins-order-pragma',
       pre_cmd('$MAKE -s --no-print-directory -C plugin-recomp package.plugins01 TOP={top}')
       ],
      makefile_test, [])
+
+test('T20803a',
+     [extra_files(['T20803-plugin/']),
+      pre_cmd('$MAKE -s --no-print-directory -C T20803-plugin package.T20803a TOP={top}')],
+     compile,
+     ['-package-db T20803-plugin/pkg.T20803a/local.package.conf -fplugin FixErrorsPlugin -package T20803-plugin ' + config.plugin_way_flags])
+
+test('T20803b',
+     [extra_files(['T20803-plugin/']),
+      pre_cmd('$MAKE -s --no-print-directory -C T20803-plugin package.T20803b TOP={top}')],
+     compile_fail,
+     ['-package-db T20803-plugin/pkg.T20803b/local.package.conf -fplugin AddErrorPlugin -package T20803-plugin ' + config.plugin_way_flags])
diff --git a/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs b/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs
index a56fc3cf4f..8cb2d87c85 100644
--- a/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs
+++ b/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs
@@ -28,10 +28,11 @@ plugin = defaultPlugin { parsedResultAction = parsedPlugin
                        }
 
 parsedPlugin :: [CommandLineOption] -> ModSummary -> HsParsedModule
-                  -> Hsc HsParsedModule
-parsedPlugin [name, "parse"] _ pm
-  = return $ pm { hpm_module = removeParsedBinding name (hpm_module pm) }
-parsedPlugin _ _ pm = return pm
+             -> (Messages PsWarning, Messages PsError)
+             -> Hsc (HsParsedModule, (Messages PsWarning, Messages PsError))
+parsedPlugin [name, "parse"] _ pm msgs
+  = return (pm { hpm_module = removeParsedBinding name (hpm_module pm) }, msgs)
+parsedPlugin _ _ pm msgs = return (pm, msgs)
 
 removeParsedBinding :: String -> Located HsModule
                          -> Located HsModule
diff --git a/testsuite/tests/plugins/simple-plugin/Simple/SourcePlugin.hs b/testsuite/tests/plugins/simple-plugin/Simple/SourcePlugin.hs
index bb0458bf3e..172a052817 100644
--- a/testsuite/tests/plugins/simple-plugin/Simple/SourcePlugin.hs
+++ b/testsuite/tests/plugins/simple-plugin/Simple/SourcePlugin.hs
@@ -26,12 +26,13 @@ plugin = defaultPlugin { parsedResultAction = parsedPlugin
                        }
 
 parsedPlugin :: [CommandLineOption] -> ModSummary -> HsParsedModule
-                  -> Hsc HsParsedModule
-parsedPlugin opts _ pm
+             -> (Messages PsWarning, Messages PsError)
+             -> Hsc (HsParsedModule, (Messages PsWarning, Messages PsError))
+parsedPlugin opts _ pm msgs
   = do liftIO $ putStrLn $ "parsePlugin(" ++ intercalate "," opts ++ ")"
        -- TODO: Remove #20791
        liftIO $ hFlush stdout
-       return pm
+       return (pm, msgs)
 
 renamedAction :: [CommandLineOption]
                     -> TcGblEnv -> HsGroup GhcRn