summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--docs/users_guide/8.10.1-notes.rst5
-rw-r--r--docs/users_guide/ghci.rst45
-rw-r--r--ghc/GHCi/UI.hs111
-rw-r--r--ghc/GHCi/UI/Monad.hs22
-rw-r--r--testsuite/tests/ghci.debugger/scripts/T2215.hs11
-rw-r--r--testsuite/tests/ghci.debugger/scripts/T2215.script26
-rw-r--r--testsuite/tests/ghci.debugger/scripts/T2215.stdout34
-rw-r--r--testsuite/tests/ghci.debugger/scripts/all.T1
8 files changed, 214 insertions, 41 deletions
diff --git a/docs/users_guide/8.10.1-notes.rst b/docs/users_guide/8.10.1-notes.rst
index af6e177b2b..fde1451250 100644
--- a/docs/users_guide/8.10.1-notes.rst
+++ b/docs/users_guide/8.10.1-notes.rst
@@ -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
~~~~~~~~~~~~~~
diff --git a/docs/users_guide/ghci.rst b/docs/users_guide/ghci.rst
index 5f4b26eeb6..a5d4aa8a3d 100644
--- a/docs/users_guide/ghci.rst
+++ b/docs/users_guide/ghci.rst
@@ -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:
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 7b64644526..ab3992ccd0 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -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)
diff --git a/ghc/GHCi/UI/Monad.hs b/ghc/GHCi/UI/Monad.hs
index 696303b949..6ecb079ea0 100644
--- a/ghc/GHCi/UI/Monad.hs
+++ b/ghc/GHCi/UI/Monad.hs
@@ -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)
diff --git a/testsuite/tests/ghci.debugger/scripts/T2215.hs b/testsuite/tests/ghci.debugger/scripts/T2215.hs
new file mode 100644
index 0000000000..7b62e031c2
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T2215.hs
@@ -0,0 +1,11 @@
+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
diff --git a/testsuite/tests/ghci.debugger/scripts/T2215.script b/testsuite/tests/ghci.debugger/scripts/T2215.script
new file mode 100644
index 0000000000..26267f6ed3
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T2215.script
@@ -0,0 +1,26 @@
+: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
diff --git a/testsuite/tests/ghci.debugger/scripts/T2215.stdout b/testsuite/tests/ghci.debugger/scripts/T2215.stdout
new file mode 100644
index 0000000000..55beaa36ae
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T2215.stdout
@@ -0,0 +1,34 @@
+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
diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T
index 5708b631fb..bc3d025dcd 100644
--- a/testsuite/tests/ghci.debugger/scripts/all.T
+++ b/testsuite/tests/ghci.debugger/scripts/all.T
@@ -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'])
View Lorry Controller Status