Make ghc -e fail on invalid declarations

Summary:
Note: This commit includes an API change to GhciMonad.runDecls
to allow the caller to determine whether the declarations were
run successfully or not.

Test Plan: harbormaster

Reviewers: austin

Reviewed By: austin

Subscribers: carter, thomie

Differential Revision: https://phabricator.haskell.org/D582

7 files changed, 26 insertions, 5 deletions

diff --git a/ghc/GhciMonad.hs b/ghc/GhciMonad.hs
index f57fbba101..19b900995a 100644
--- a/ghc/GhciMonad.hs
+++ b/ghc/GhciMonad.hs
@@ -277,15 +277,17 @@ runStmt expr step = do
           r <- GHC.runStmtWithLocation (progname st) (line_number st) expr step
           return (Just r)
 
-runDecls :: String -> GHCi [GHC.Name]
+runDecls :: String -> GHCi (Maybe [GHC.Name])
 runDecls decls = do
   st <- getGHCiState
   reifyGHCi $ \x ->
     withProgName (progname st) $
     withArgs (args st) $
       reflectGHCi x $ do
-        GHC.handleSourceError (\e -> do GHC.printException e; return []) $ do
-          GHC.runDeclsWithLocation (progname st) (line_number st) decls
+        GHC.handleSourceError (\e -> do GHC.printException e;
+                                        return Nothing) $ do
+          r <- GHC.runDeclsWithLocation (progname st) (line_number st) decls
+          return (Just r)
 
 resume :: (SrcSpan -> Bool) -> GHC.SingleStep -> GHCi GHC.RunResult
 resume canLogSpan step = do
diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index ce73c48ce5..7125f6d9b3 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -915,8 +915,10 @@ runStmt stmt step
   where
     run_decl =
         do _ <- liftIO $ tryIO $ hFlushAll stdin
-           result <- GhciMonad.runDecls stmt
-           afterRunStmt (const True) (GHC.RunOk result)
+           m_result <- GhciMonad.runDecls stmt
+           case m_result of
+               Nothing     -> return False
+               Just result -> afterRunStmt (const True) (GHC.RunOk result)
 
     run_stmt =
         do -- In the new IO library, read handles buffer data even if the Handle
diff --git a/testsuite/tests/ghc-e/should_fail/Makefile b/testsuite/tests/ghc-e/should_fail/Makefile
index 7a02f7bea3..c0cebcd546 100644
--- a/testsuite/tests/ghc-e/should_fail/Makefile
+++ b/testsuite/tests/ghc-e/should_fail/Makefile
@@ -13,3 +13,9 @@ T9905fail2:
 
 T9905fail3:
 	'$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -e "import Prelude (+)" # syntax error
+
+ghc-e-fail1:
+	'$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -e "class ["
+
+ghc-e-fail2:
+	'$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -e "type A = A"
diff --git a/testsuite/tests/ghc-e/should_fail/all.T b/testsuite/tests/ghc-e/should_fail/all.T
index 07dc614eab..bfd4a8a0f1 100644
--- a/testsuite/tests/ghc-e/should_fail/all.T
+++ b/testsuite/tests/ghc-e/should_fail/all.T
@@ -11,3 +11,9 @@ test('T9905fail2', [exit_code(2), req_interp, ignore_output], run_command,
 
 test('T9905fail3', [exit_code(2), req_interp, ignore_output], run_command,
      ['$MAKE --no-print-directory -s T9905fail3'])
+
+test('ghc-e-fail1', [exit_code(2), req_interp, ignore_output], run_command,
+     ['$MAKE --no-print-directory -s ghc-e-fail1'])
+
+test('ghc-e-fail2', [exit_code(2), req_interp, ignore_output], run_command,
+     ['$MAKE --no-print-directory -s ghc-e-fail2'])
diff --git a/testsuite/tests/ghc-e/should_run/Makefile b/testsuite/tests/ghc-e/should_run/Makefile
index aa7041bc13..54ce8a31cc 100644
--- a/testsuite/tests/ghc-e/should_run/Makefile
+++ b/testsuite/tests/ghc-e/should_run/Makefile
@@ -18,6 +18,9 @@ ghc-e004:
 ghc-e005:
 	'$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -main-is foo ghc-e005.hs -e ":set prog ghc-e005-prog" -e ":main [\"the\",\"args\"]"; echo $$?
 
+ghc-e006:
+	'$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -e "data X = X deriving Show" -e "X"
+
 T2228:
 	'$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -e ":main" T2228.hs
 
diff --git a/testsuite/tests/ghc-e/should_run/all.T b/testsuite/tests/ghc-e/should_run/all.T
index 329ceea7f7..0e6f7f9c17 100644
--- a/testsuite/tests/ghc-e/should_run/all.T
+++ b/testsuite/tests/ghc-e/should_run/all.T
@@ -6,6 +6,7 @@ test('ghc-e002', req_interp, run_command, ['$MAKE --no-print-directory -s ghc-e0
 test('ghc-e003', req_interp, run_command, ['$MAKE --no-print-directory -s ghc-e003'])
 test('ghc-e004', req_interp, run_command, ['$MAKE --no-print-directory -s ghc-e004'])
 test('ghc-e005', req_interp, run_command, ['$MAKE --no-print-directory -s ghc-e005'])
+test('ghc-e006', req_interp, run_command, ['$MAKE --no-print-directory -s ghc-e006'])
 
 test('T2228',
      [req_interp, when(ghci_dynamic(), expect_broken(7298))],
diff --git a/testsuite/tests/ghc-e/should_run/ghc-e006.stdout b/testsuite/tests/ghc-e/should_run/ghc-e006.stdout
new file mode 100644
index 0000000000..62d8fe9f6d
--- /dev/null
+++ b/testsuite/tests/ghc-e/should_run/ghc-e006.stdout
@@ -0,0 +1 @@
+X