Commit 24f608a8 authored by mnislaih's avatar mnislaih
Browse files

Virtualize the cwd in GHCi

This fixes the issue where :list would stop working if the
program being debugged side-effected the working directory,
and should prevent other similar issues
parent ddb4c07d
......@@ -39,6 +39,8 @@ import Data.IORef
import Data.List
import Data.Typeable
import System.CPUTime
import System.Directory
import System.Environment
import System.IO
import Control.Monad as Monad
import GHC.Exts
......@@ -68,13 +70,14 @@ data GHCiState = GHCiState
-- remember is here:
last_command :: Maybe Command,
cmdqueue :: [String],
remembered_ctx :: [(CtxtCmd, [String], [String])]
remembered_ctx :: [(CtxtCmd, [String], [String])],
-- we remember the :module commands between :loads, so that
-- on a :reload we can replay them. See bugs #2049,
-- #1873, #1360. Previously we tried to remember modules that
-- were supposed to be in the context but currently had errors,
-- but this was complicated. Just replaying the :module commands
-- seems to be the right thing.
virtual_path :: FilePath
}
data CtxtCmd
......@@ -193,6 +196,30 @@ printForUserPartWay doc = do
unqual <- io (GHC.getPrintUnqual session)
io $ Outputable.printForUserPartWay stdout opt_PprUserLength unqual doc
withVirtualPath :: GHCi a -> GHCi a
withVirtualPath m = do
ghci_wd <- io getCurrentDirectory -- Store the cwd of GHCi
st <- getGHCiState
io$ setCurrentDirectory (virtual_path st)
result <- m -- Evaluate in the virtual wd..
vwd <- io getCurrentDirectory
setGHCiState (st{ virtual_path = vwd}) -- Update the virtual path
io$ setCurrentDirectory ghci_wd -- ..and restore GHCi wd
return result
runStmt :: String -> GHC.SingleStep -> GHCi GHC.RunResult
runStmt expr step = withVirtualPath$ do
session <- getSession
st <- getGHCiState
io$ withProgName (progname st) $ withArgs (args st) $
GHC.runStmt session expr step
resume :: GHC.SingleStep -> GHCi GHC.RunResult
resume step = withVirtualPath$ do
session <- getSession
io$ GHC.resume session step
-- --------------------------------------------------------------------------
-- timing & statistics
......
......@@ -11,12 +11,13 @@ module InteractiveUI ( interactiveUI, ghciWelcomeMsg ) where
#include "HsVersions.h"
import GhciMonad
import qualified GhciMonad
import GhciMonad hiding (runStmt)
import GhciTags
import Debugger
-- The GHC interface
import qualified GHC
import qualified GHC hiding (resume, runStmt)
import GHC ( Session, LoadHowMuch(..), Target(..), TargetId(..),
Module, ModuleName, TyThing(..), Phase,
BreakIndex, SrcSpan, Resume, SingleStep )
......@@ -335,6 +336,8 @@ interactiveUI session srcs maybe_exprs = do
default_editor <- findEditor
cwd <- getCurrentDirectory
startGHCi (runGHCi srcs maybe_exprs)
GHCiState{ progname = "<interactive>",
args = [],
......@@ -349,7 +352,8 @@ interactiveUI session srcs maybe_exprs = do
tickarrays = emptyModuleEnv,
last_command = Nothing,
cmdqueue = [],
remembered_ctx = []
remembered_ctx = [],
virtual_path = cwd
}
#ifdef USE_EDITLINE
......@@ -685,13 +689,9 @@ runStmt stmt step
| null (filter (not.isSpace) stmt) = return False
| ["import", mod] <- words stmt = keepGoing setContext ('+':mod)
| otherwise
= do st <- getGHCiState
session <- getSession
result <- io $ withProgName (progname st) $ withArgs (args st) $
GHC.runStmt session stmt step
= do result <- GhciMonad.runStmt stmt step
afterRunStmt (const True) result
--afterRunStmt :: GHC.RunResult -> GHCi Bool
-- False <=> the statement failed to compile
afterRunStmt :: (SrcSpan -> Bool) -> GHC.RunResult -> GHCi Bool
......@@ -719,7 +719,7 @@ afterRunStmt step_here run_result = do
st <- getGHCiState
enqueueCommands [stop st]
return ()
| otherwise -> io(GHC.resume session GHC.SingleStep) >>=
| otherwise -> resume GHC.SingleStep >>=
afterRunStmt step_here >> return ()
_ -> return ()
......@@ -1946,8 +1946,7 @@ continueCmd = noArgs $ doContinue (const True) GHC.RunToCompletion
-- doContinue :: SingleStep -> GHCi ()
doContinue :: (SrcSpan -> Bool) -> SingleStep -> GHCi ()
doContinue pred step = do
session <- getSession
runResult <- io $ GHC.resume session step
runResult <- resume step
afterRunStmt pred runResult
return ()
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment