Skip to content
Snippets Groups Projects
Commit 45668525 authored by rwbarton's avatar rwbarton Committed by Herbert Valerio Riedel
Browse files

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 878910e1)
parent a6435591
No related merge requests found
......@@ -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
......
......@@ -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
......
......@@ -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
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'])
......@@ -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]"
[1,2]
[1,2]
......@@ -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'])
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment