[commit: ghc] ghc-7.10: Make ghc -e not exit on valid import commands (#9905) (4566852)

git at git.haskell.org git at git.haskell.org
Sat Dec 27 12:12:12 UTC 2014


Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-7.10
Link       : http://ghc.haskell.org/trac/ghc/changeset/45668525c0f100d4ac7f55eec744ca3ac00c304c/ghc

>---------------------------------------------------------------

commit 45668525c0f100d4ac7f55eec744ca3ac00c304c
Author: Reid Barton <rwbarton at gmail.com>
Date:   Tue Dec 23 15:22:01 2014 -0500

    Make ghc -e not exit on valid import commands (#9905)
    
    Some Trues and Falses were mixed up due to Bool being used in
    different senses in different parts of GHCi.
    
    (cherry picked from commit 878910e1c4520732ab9d8372c1c81f00d484e48f)


>---------------------------------------------------------------

45668525c0f100d4ac7f55eec744ca3ac00c304c
 ghc/GhciMonad.hs                               |  1 +
 ghc/InteractiveUI.hs                           | 22 ++++++++++++++--------
 testsuite/tests/ghc-e/should_fail/Makefile     |  9 +++++++++
 testsuite/tests/ghc-e/should_fail/all.T        | 12 +++++++++++-
 testsuite/tests/ghc-e/should_run/Makefile      |  6 ++++++
 testsuite/tests/ghc-e/should_run/T9905.stdout  |  1 +
 testsuite/tests/ghc-e/should_run/T9905b.stdout |  1 +
 testsuite/tests/ghc-e/should_run/all.T         |  2 ++
 8 files changed, 45 insertions(+), 9 deletions(-)

diff --git a/ghc/GhciMonad.hs b/ghc/GhciMonad.hs
index 89c2028..f57fbba 100644
--- a/ghc/GhciMonad.hs
+++ b/ghc/GhciMonad.hs
@@ -63,6 +63,7 @@ import Control.Applicative (Applicative(..))
 -----------------------------------------------------------------------------
 -- GHCi monad
 
+-- the Bool means: True = we should exit GHCi (:quit)
 type Command = (String, String -> InputT GHCi Bool, CompletionFunc GHCi)
 
 data GHCiState = GHCiState
diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index d478336..ce73c48 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -729,7 +729,11 @@ runCommands' eh sourceErrorHandler gCmd = do
         when (not success) $ maybe (return ()) lift sourceErrorHandler
         runCommands' eh sourceErrorHandler gCmd
 
--- | Evaluate a single line of user input (either :<command> or Haskell code)
+-- | Evaluate a single line of user input (either :<command> or Haskell code).
+-- A result of Nothing means there was no more input to process.
+-- Otherwise the result is Just b where b is True if the command succeeded;
+-- this is relevant only to ghc -e, which will exit with status 1
+-- if the commmand was unsuccessful. GHCi will continue in either case.
 runOneCommand :: (SomeException -> GHCi Bool) -> InputT GHCi (Maybe String)
             -> InputT GHCi (Maybe Bool)
 runOneCommand eh gCmd = do
@@ -740,14 +744,14 @@ runOneCommand eh gCmd = do
   case mb_cmd1 of
     Nothing -> return Nothing
     Just c  -> ghciHandle (\e -> lift $ eh e >>= return . Just) $
-             handleSourceError printErrorAndKeepGoing
+             handleSourceError printErrorAndFail
                (doCommand c)
                -- source error's are handled by runStmt
                -- is the handler necessary here?
   where
-    printErrorAndKeepGoing err = do
+    printErrorAndFail err = do
         GHC.printException err
-        return $ Just True
+        return $ Just False     -- Exit ghc -e, but not GHCi
 
     noSpace q = q >>= maybe (return Nothing)
                             (\c -> case removeSpaces c of
@@ -890,16 +894,18 @@ declPrefixes dflags = keywords ++ concat opt_keywords
                    , ["deriving " | xopt Opt_StandaloneDeriving dflags]
                    ]
 
--- | Entry point to execute some haskell code from user
+-- | Entry point to execute some haskell code from user.
+-- The return value True indicates success, as in `runOneCommand`.
 runStmt :: String -> SingleStep -> GHCi Bool
 runStmt stmt step
- -- empty
+ -- empty; this should be impossible anyways since we filtered out
+ -- whitespace-only input in runOneCommand's noSpace
  | null (filter (not.isSpace) stmt)
- = return False
+ = return True
 
  -- import
  | stmt `looks_like` "import "
- = do addImportToContext stmt; return False
+ = do addImportToContext stmt; return True
 
  | otherwise
  = do dflags <- getDynFlags
diff --git a/testsuite/tests/ghc-e/should_fail/Makefile b/testsuite/tests/ghc-e/should_fail/Makefile
index 5b0d753..7a02f7b 100644
--- a/testsuite/tests/ghc-e/should_fail/Makefile
+++ b/testsuite/tests/ghc-e/should_fail/Makefile
@@ -4,3 +4,12 @@ include $(TOP)/mk/test.mk
 
 T7962:
 	'$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -e "return ("
+
+T9905fail1:
+	'$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -e "import This.Module.Does.Not.Exist"
+
+T9905fail2:
+	'$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -e "import Data.List (bogusIdentifier)"
+
+T9905fail3:
+	'$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -e "import Prelude (+)" # syntax error
diff --git a/testsuite/tests/ghc-e/should_fail/all.T b/testsuite/tests/ghc-e/should_fail/all.T
index 4c5ac5c..07dc614 100644
--- a/testsuite/tests/ghc-e/should_fail/all.T
+++ b/testsuite/tests/ghc-e/should_fail/all.T
@@ -1,3 +1,13 @@
 setTestOpts(when(compiler_profiled(), skip))
 
-test('T7962', [exit_code(2), req_interp, ignore_output], run_command, ['$MAKE --no-print-directory -s T7962'])
+test('T7962', [exit_code(2), req_interp, ignore_output], run_command,
+     ['$MAKE --no-print-directory -s T7962'])
+
+test('T9905fail1', [exit_code(2), req_interp, ignore_output], run_command,
+     ['$MAKE --no-print-directory -s T9905fail1'])
+
+test('T9905fail2', [exit_code(2), req_interp, ignore_output], run_command,
+     ['$MAKE --no-print-directory -s T9905fail2'])
+
+test('T9905fail3', [exit_code(2), req_interp, ignore_output], run_command,
+     ['$MAKE --no-print-directory -s T9905fail3'])
diff --git a/testsuite/tests/ghc-e/should_run/Makefile b/testsuite/tests/ghc-e/should_run/Makefile
index 5ed1ec2..aa7041b 100644
--- a/testsuite/tests/ghc-e/should_run/Makefile
+++ b/testsuite/tests/ghc-e/should_run/Makefile
@@ -32,3 +32,9 @@ T7299:
 
 T9086:
 	'$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -e ":main" T9086.hs
+
+T9905:
+	'$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -e "import Data.List" -e "sort [2,1]"
+
+T9905b:
+	'$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -e "import qualified Data.List as L" -e "L.sort [2,1]"
diff --git a/testsuite/tests/ghc-e/should_run/T9905.stdout b/testsuite/tests/ghc-e/should_run/T9905.stdout
new file mode 100644
index 0000000..6ed63af
--- /dev/null
+++ b/testsuite/tests/ghc-e/should_run/T9905.stdout
@@ -0,0 +1 @@
+[1,2]
diff --git a/testsuite/tests/ghc-e/should_run/T9905b.stdout b/testsuite/tests/ghc-e/should_run/T9905b.stdout
new file mode 100644
index 0000000..6ed63af
--- /dev/null
+++ b/testsuite/tests/ghc-e/should_run/T9905b.stdout
@@ -0,0 +1 @@
+[1,2]
diff --git a/testsuite/tests/ghc-e/should_run/all.T b/testsuite/tests/ghc-e/should_run/all.T
index 9f64918..329ceea 100644
--- a/testsuite/tests/ghc-e/should_run/all.T
+++ b/testsuite/tests/ghc-e/should_run/all.T
@@ -15,3 +15,5 @@ test('T2636', req_interp, run_command, ['$MAKE --no-print-directory -s T2636'])
 test('T3890', req_interp, run_command, ['$MAKE --no-print-directory -s T3890'])
 test('T7299', req_interp, run_command, ['$MAKE --no-print-directory -s T7299'])
 test('T9086', req_interp, run_command, ['$MAKE --no-print-directory -s T9086'])
+test('T9905', req_interp, run_command, ['$MAKE --no-print-directory -s T9905'])
+test('T9905b', req_interp, run_command, ['$MAKE --no-print-directory -s T9905b'])



More information about the ghc-commits mailing list