Commit 10452959 authored by Roland Senn's avatar Roland Senn Committed by Marge Bot

Add disable/enable commands to ghci debugger #2215

This patch adds two new commands `:enable` and `:disable` to the GHCi debugger.
Opposite to `:set stop <n> :continue` a breakpoint disabled with `:disable` will
not loose its previously set stop command.
A new field breakEnabled is added to the BreakLocation data structure to
track the enable/disable state. When a breakpoint is disabled with a `:disable`
command, the following happens:

The corresponding BreakLocation data element is searched dictionary of the
`breaks` field of the GHCiStateMonad. If the break point is found and not
already in the disabled state, the breakpoint is removed from bytecode.
The BreakLocation data structure is kept in the breaks list and the new
breakEnabled field is set to false.

The `:enable` command works similar.

The breaks field in the GHCiStateMonad was changed from an association list
to int `IntMap`.
parent a22e51ea
Pipeline #6760 passed with stages
in 418 minutes and 27 seconds
......@@ -96,7 +96,7 @@ Compiler
`copyByteArray#` calls that were not optimized before, now will
be. See :ghc-ticket:`16052`.
- GHC's runtime linker no longer uses global state. This allows programs
that use the GHC API to safely use multiple GHC sessions in a single
that use the GHC API to safely use multiple GHC sessions in a single
process, as long as there are no native dependencies that rely on
global state.
......@@ -112,6 +112,9 @@ GHCi
- Added a command `:instances` to show the class instances available for a type.
- Added new debugger commands :ghci-cmd:`:disable` and :ghci-cmd:`:enable` to
disable and re-enable breakpoints.
Runtime system
~~~~~~~~~~~~~~
......
......@@ -1556,17 +1556,32 @@ breakpoint on a let expression, but there will always be a breakpoint on
its body, because we are usually interested in inspecting the values of
the variables bound by the let.
Listing and deleting breakpoints
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Managing breakpoints
^^^^^^^^^^^^^^^^^^^^
The list of breakpoints currently enabled can be displayed using
The list of breakpoints currently defined can be displayed using
:ghci-cmd:`:show breaks`:
.. code-block:: none
*Main> :show breaks
[0] Main qsort.hs:1:11-12
[1] Main qsort.hs:2:15-46
[0] Main qsort.hs:1:11-12 enabled
[1] Main qsort.hs:2:15-46 enabled
To disable one or several defined breakpoint, use the :ghci-cmd:`:disable` command with
one or several blank separated numbers
given in the output from :ghci-cmd:`:show breaks`:.
To disable all breakpoints at once, use ``:disable *``.
.. code-block:: none
*Main> :disable 0
*Main> :show breaks
[0] Main qsort.hs:1:11-12 disabled
[1] Main qsort.hs:2:15-46 enabled
Disabled breakpoints can be (re-)enabled with the :ghci-cmd:`:enable` command.
The parameters of the :ghci-cmd:`:disable` and :ghci-cmd:`:enable` commands are identical.
To delete a breakpoint, use the :ghci-cmd:`:delete` command with the number
given in the output from :ghci-cmd:`:show breaks`:
......@@ -1575,7 +1590,7 @@ given in the output from :ghci-cmd:`:show breaks`:
*Main> :delete 0
*Main> :show breaks
[1] Main qsort.hs:2:15-46
[1] Main qsort.hs:2:15-46 disabled
To delete all breakpoints at once, use ``:delete *``.
......@@ -2377,6 +2392,12 @@ commonly used commands.
see the number of each breakpoint). The ``*`` form deletes all the
breakpoints.
.. ghci-cmd:: :disable; * | ⟨num⟩ ...
Disable one or more breakpoints by number (use :ghci-cmd:`:show breaks` to
see the number and state of each breakpoint). The ``*`` form disables all the
breakpoints.
.. ghci-cmd:: :doc; ⟨name⟩
(Experimental: This command will likely change significantly in GHC 8.8.)
......@@ -2394,6 +2415,12 @@ commonly used commands.
variable, or a default editor on your system if :envvar:`EDITOR` is not
set. You can change the editor using :ghci-cmd:`:set editor`.
.. ghci-cmd:: :enable; * | ⟨num⟩ ...
Enable one or more disabled breakpoints by number (use :ghci-cmd:`:show breaks` to
see the number and state of each breakpoint). The ``*`` form enables all the
disabled breakpoints.
.. ghci-cmd:: :etags
See :ghci-cmd:`:ctags`.
......@@ -2764,8 +2791,10 @@ commonly used commands.
If a number is given before the command, then the commands are run
when the specified breakpoint (only) is hit. This can be quite
useful: for example, ``:set stop 1 :continue`` effectively disables
breakpoint 1, by running :ghci-cmd:`:continue` whenever it is hit (although
GHCi will still emit a message to say the breakpoint was hit). What's more,
breakpoint 1, by running :ghci-cmd:`:continue` whenever it is hit
In this case GHCi will still emit a message to say the breakpoint was hit.
If you don't want such a message, you can use the :ghci-cmd:`:disable`
command. What's more,
with cunning use of :ghci-cmd:`:def` and :ghci-cmd:`:cmd` you can use
:ghci-cmd:`:set stop` to implement conditional breakpoints:
......
......@@ -108,6 +108,7 @@ import qualified Data.Set as S
import Data.Maybe
import Data.Map (Map)
import qualified Data.Map as M
import qualified Data.IntMap.Strict as IntMap
import Data.Time.LocalTime ( getZonedTime )
import Data.Time.Format ( formatTime, defaultTimeLocale )
import Data.Version ( showVersion )
......@@ -187,8 +188,10 @@ ghciCommands = map mkCmd [
("def", keepGoing (defineMacro False), completeExpression),
("def!", keepGoing (defineMacro True), completeExpression),
("delete", keepGoing deleteCmd, noCompletion),
("disable", keepGoing disableCmd, noCompletion),
("doc", keepGoing' docCmd, completeIdentifier),
("edit", keepGoing' editFile, completeFilename),
("enable", keepGoing enableCmd, noCompletion),
("etags", keepGoing createETagsFileCmd, completeFilename),
("force", keepGoing forceCmd, completeExpression),
("forward", keepGoing forwardCmd, noCompletion),
......@@ -331,8 +334,12 @@ defFullHelpText =
" :break [<mod>] <l> [<col>] set a breakpoint at the specified location\n" ++
" :break <name> set a breakpoint on the specified function\n" ++
" :continue resume after a breakpoint\n" ++
" :delete <number> delete the specified breakpoint\n" ++
" :delete <number> ... delete the specified breakpoints\n" ++
" :delete * delete all breakpoints\n" ++
" :disable <number> ... disable the specified breakpoints\n" ++
" :disable * disable all breakpoints\n" ++
" :enable <number> ... enable the specified breakpoints\n" ++
" :enable * enable all breakpoints\n" ++
" :force <expr> print <expr>, forcing unevaluated parts\n" ++
" :forward [<n>] go forward in the history N step s(after :back)\n" ++
" :history [<n>] after :trace, show the execution history\n" ++
......@@ -493,7 +500,7 @@ interactiveUI config srcs maybe_exprs = do
-- incremented after reading a line.
line_number = 0,
break_ctr = 0,
breaks = [],
breaks = IntMap.empty,
tickarrays = emptyModuleEnv,
ghci_commands = availableCommands config,
ghci_macros = [],
......@@ -1300,7 +1307,7 @@ toBreakIdAndLocation (Just inf) = do
let md = GHC.breakInfo_module inf
nm = GHC.breakInfo_number inf
st <- getGHCiState
return $ listToMaybe [ id_loc | id_loc@(_,loc) <- breaks st,
return $ listToMaybe [ id_loc | id_loc@(_,loc) <- IntMap.assocs (breaks st),
breakModule loc == md,
breakTick loc == nm ]
......@@ -2813,14 +2820,14 @@ setStop str@(c:_) | isDigit c
nm = read nm_str
st <- getGHCiState
let old_breaks = breaks st
if all ((/= nm) . fst) old_breaks
then printForUser (text "Breakpoint" <+> ppr nm <+>
text "does not exist")
else do
let new_breaks = map fn old_breaks
fn (i,loc) | i == nm = (i,loc { onBreakCmd = dropWhile isSpace rest })
| otherwise = (i,loc)
setGHCiState st{ breaks = new_breaks }
case IntMap.lookup nm old_breaks of
Nothing -> printForUser (text "Breakpoint" <+> ppr nm <+>
text "does not exist")
Just loc -> do
let new_breaks = IntMap.insert nm
loc { onBreakCmd = dropWhile isSpace rest }
old_breaks
setGHCiState st{ breaks = new_breaks }
setStop cmd = modifyGHCiState (\st -> st { stop = cmd })
setPrompt :: GhciMonad m => PromptFunction -> m ()
......@@ -3521,6 +3528,56 @@ deleteCmd argLine = withSandboxOnly ":delete" $ do
| all isDigit str = deleteBreak (read str)
| otherwise = return ()
enableCmd :: GhciMonad m => String -> m ()
enableCmd argLine = withSandboxOnly ":enable" $ do
enaDisaSwitch True $ words argLine
disableCmd :: GhciMonad m => String -> m ()
disableCmd argLine = withSandboxOnly ":disable" $ do
enaDisaSwitch False $ words argLine
enaDisaSwitch :: GhciMonad m => Bool -> [String] -> m ()
enaDisaSwitch enaDisa [] =
printForUser (text "The" <+> text strCmd <+>
text "command requires at least one argument.")
where
strCmd = if enaDisa then ":enable" else ":disable"
enaDisaSwitch enaDisa ("*" : _) = enaDisaAllBreaks enaDisa
enaDisaSwitch enaDisa idents = do
mapM_ (enaDisaOneBreak enaDisa) idents
where
enaDisaOneBreak :: GhciMonad m => Bool -> String -> m ()
enaDisaOneBreak enaDisa strId = do
sdoc_loc <- getBreakLoc enaDisa strId
case sdoc_loc of
Left sdoc -> printForUser sdoc
Right loc -> enaDisaAssoc enaDisa (read strId, loc)
getBreakLoc :: GhciMonad m => Bool -> String -> m (Either SDoc BreakLocation)
getBreakLoc enaDisa strId = do
st <- getGHCiState
case readMaybe strId >>= flip IntMap.lookup (breaks st) of
Nothing -> return $ Left (text "Breakpoint" <+> text strId <+>
text "not found")
Just loc ->
if breakEnabled loc == enaDisa
then return $ Left
(text "Breakpoint" <+> text strId <+>
text "already in desired state")
else return $ Right loc
enaDisaAssoc :: GhciMonad m => Bool -> (Int, BreakLocation) -> m ()
enaDisaAssoc enaDisa (intId, loc) = do
st <- getGHCiState
newLoc <- turnBreakOnOff enaDisa loc
let new_breaks = IntMap.insert intId newLoc (breaks st)
setGHCiState $ st { breaks = new_breaks }
enaDisaAllBreaks :: GhciMonad m => Bool -> m()
enaDisaAllBreaks enaDisa = do
st <- getGHCiState
mapM_ (enaDisaAssoc enaDisa) $ IntMap.assocs $ breaks st
historyCmd :: GHC.GhcMonad m => String -> m ()
historyCmd arg
| null arg = history 20
......@@ -3648,6 +3705,7 @@ findBreakAndSet md lookupTickTree = do
, breakLoc = RealSrcSpan pan
, breakTick = tick
, onBreakCmd = ""
, breakEnabled = True
}
printForUser $
text "Breakpoint " <> ppr nm <>
......@@ -3913,26 +3971,29 @@ mkTickArray ticks
discardActiveBreakPoints :: GhciMonad m => m ()
discardActiveBreakPoints = do
st <- getGHCiState
mapM_ (turnOffBreak.snd) (breaks st)
setGHCiState $ st { breaks = [] }
mapM_ (turnBreakOnOff False) $ breaks st
setGHCiState $ st { breaks = IntMap.empty }
deleteBreak :: GhciMonad m => Int -> m ()
deleteBreak identity = do
st <- getGHCiState
let oldLocations = breaks st
(this,rest) = partition (\loc -> fst loc == identity) oldLocations
if null this
then printForUser (text "Breakpoint" <+> ppr identity <+>
text "does not exist")
else do
mapM_ (turnOffBreak.snd) this
let oldLocations = breaks st
case IntMap.lookup identity oldLocations of
Nothing -> printForUser (text "Breakpoint" <+> ppr identity <+>
text "does not exist")
Just loc -> do
_ <- (turnBreakOnOff False) loc
let rest = IntMap.delete identity oldLocations
setGHCiState $ st { breaks = rest }
turnOffBreak :: GHC.GhcMonad m => BreakLocation -> m ()
turnOffBreak loc = do
(arr, _) <- getModBreak (breakModule loc)
hsc_env <- GHC.getSession
liftIO $ enableBreakpoint hsc_env arr (breakTick loc) False
turnBreakOnOff :: GHC.GhcMonad m => Bool -> BreakLocation -> m BreakLocation
turnBreakOnOff onOff loc
| onOff == breakEnabled loc = return loc
| otherwise = do
(arr, _) <- getModBreak (breakModule loc)
hsc_env <- GHC.getSession
liftIO $ enableBreakpoint hsc_env arr (breakTick loc) onOff
return loc { breakEnabled = onOff }
getModBreak :: GHC.GhcMonad m
=> Module -> m (ForeignRef BreakArray, Array Int SrcSpan)
......
......@@ -66,6 +66,7 @@ import qualified System.Console.Haskeline as Haskeline
import Control.Monad.Trans.Class
import Control.Monad.IO.Class
import Data.Map.Strict (Map)
import qualified Data.IntMap.Strict as IntMap
import qualified GHC.LanguageExtensions as LangExt
-----------------------------------------------------------------------------
......@@ -84,7 +85,7 @@ data GHCiState = GHCiState
options :: [GHCiOption],
line_number :: !Int, -- ^ input line
break_ctr :: !Int,
breaks :: ![(Int, BreakLocation)],
breaks :: !(IntMap.IntMap BreakLocation),
tickarrays :: ModuleEnv TickArray,
-- ^ 'tickarrays' caches the 'TickArray' for loaded modules,
-- so that we don't rebuild it each time the user sets
......@@ -213,6 +214,7 @@ data BreakLocation
{ breakModule :: !GHC.Module
, breakLoc :: !SrcSpan
, breakTick :: {-# UNPACK #-} !Int
, breakEnabled:: !Bool
, onBreakCmd :: String
}
......@@ -220,21 +222,27 @@ instance Eq BreakLocation where
loc1 == loc2 = breakModule loc1 == breakModule loc2 &&
breakTick loc1 == breakTick loc2
prettyLocations :: [(Int, BreakLocation)] -> SDoc
prettyLocations [] = text "No active breakpoints."
prettyLocations locs = vcat $ map (\(i, loc) -> brackets (int i) <+> ppr loc) $ reverse $ locs
prettyLocations :: IntMap.IntMap BreakLocation -> SDoc
prettyLocations locs =
case IntMap.null locs of
True -> text "No active breakpoints."
False -> vcat $ map (\(i, loc) -> brackets (int i) <+> ppr loc) $ IntMap.toAscList locs
instance Outputable BreakLocation where
ppr loc = (ppr $ breakModule loc) <+> ppr (breakLoc loc) <+>
ppr loc = (ppr $ breakModule loc) <+> ppr (breakLoc loc) <+> pprEnaDisa <+>
if null (onBreakCmd loc)
then Outputable.empty
else doubleQuotes (text (onBreakCmd loc))
where pprEnaDisa = case breakEnabled loc of
True -> text "enabled"
False -> text "disabled"
recordBreak
:: GhciMonad m => BreakLocation -> m (Bool{- was already present -}, Int)
recordBreak brkLoc = do
st <- getGHCiState
let oldActiveBreaks = breaks st
let oldmap = breaks st
oldActiveBreaks = IntMap.assocs oldmap
-- don't store the same break point twice
case [ nm | (nm, loc) <- oldActiveBreaks, loc == brkLoc ] of
(nm:_) -> return (True, nm)
......@@ -242,7 +250,7 @@ recordBreak brkLoc = do
let oldCounter = break_ctr st
newCounter = oldCounter + 1
setGHCiState $ st { break_ctr = newCounter,
breaks = (oldCounter, brkLoc) : oldActiveBreaks
breaks = IntMap.insert oldCounter brkLoc oldmap
}
return (False, oldCounter)
......
import System.Environment
qsort :: [Int] -> [Int]
qsort [] = []
qsort (a:as) = qsort left ++ [a] ++ qsort right
where (left,right) = (filter (<=a) as, filter (>a) as)
main :: IO()
main = do
args <- getArgs
print $ qsort $ map read $ args
:l T2215.hs
:break 5
:break 6
:show breaks
:main 5 21 7 13 8
:abandon
:disable 0
:show breaks
:main 5 21 7 13 8
:abandon
:disable 1
:disable 1
:show breaks
:main 5 21 7 13 8
:enable 0
:enable 0
:show breaks
:main 5 21 7 13 8
:disable 0
:continue
:enable *
:show breaks
:disable *
:show breaks
:enable 0 1
:show breaks
Breakpoint 0 activated at T2215.hs:5:16-47
Breakpoint 1 activated at T2215.hs:6:24-56
[0] Main T2215.hs:5:16-47 enabled
[1] Main T2215.hs:6:24-56 enabled
Stopped in Main.qsort, T2215.hs:5:16-47
_result :: [Int] = _
a :: Int = _
left :: [Int] = _
right :: [Int] = _
[0] Main T2215.hs:5:16-47 disabled
[1] Main T2215.hs:6:24-56 enabled
Stopped in Main.qsort.(...), T2215.hs:6:24-56
_result :: ([Int], [Int]) = _
a :: Int = _
as :: [Int] = _
Breakpoint 1 already in desired state
[0] Main T2215.hs:5:16-47 disabled
[1] Main T2215.hs:6:24-56 disabled
[5,7,8,13,21]
Breakpoint 0 already in desired state
[0] Main T2215.hs:5:16-47 enabled
[1] Main T2215.hs:6:24-56 disabled
Stopped in Main.qsort, T2215.hs:5:16-47
_result :: [Int] = _
a :: Int = _
left :: [Int] = _
right :: [Int] = _
[5,7,8,13,21]
[0] Main T2215.hs:5:16-47 enabled
[1] Main T2215.hs:6:24-56 enabled
[0] Main T2215.hs:5:16-47 disabled
[1] Main T2215.hs:6:24-56 disabled
[0] Main T2215.hs:5:16-47 enabled
[1] Main T2215.hs:6:24-56 enabled
......@@ -111,3 +111,4 @@ test('T13825-debugger', when(arch('powerpc64'), expect_broken(14455)),
test('T16700', normal, ghci_script, ['T16700.script'])
test('break029', extra_files(['break029.hs']), ghci_script, ['break029.script'])
test('T2215', normal, ghci_script, ['T2215.script'])
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