summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ghc/GHCi/UI.hs118
-rw-r--r--testsuite/tests/ghci.debugger/scripts/T17989.script12
-rw-r--r--testsuite/tests/ghci.debugger/scripts/T17989.stdout20
-rw-r--r--testsuite/tests/ghci.debugger/scripts/T17989A.hs13
-rw-r--r--testsuite/tests/ghci.debugger/scripts/T17989B.hs13
-rw-r--r--testsuite/tests/ghci.debugger/scripts/T17989C.hs7
-rw-r--r--testsuite/tests/ghci.debugger/scripts/T17989M.hs6
-rw-r--r--testsuite/tests/ghci.debugger/scripts/all.T1
8 files changed, 180 insertions, 10 deletions
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 2416fd9d9d..87826438e3 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -48,7 +48,7 @@ import qualified GHC
import GHC ( LoadHowMuch(..), Target(..), TargetId(..), InteractiveImport(..),
TyThing(..), Phase, BreakIndex, Resume, SingleStep, Ghc,
GetDocsFailure(..),
- getModuleGraph, handleSourceError )
+ getModuleGraph, handleSourceError, ms_mod )
import GHC.Driver.Main (hscParseDeclsWithLocation, hscParseStmtWithLocation)
import GHC.Hs.ImpExp
import GHC.Hs
@@ -100,8 +100,8 @@ import qualified Data.ByteString.Char8 as BS
import Data.Char
import Data.Function
import Data.IORef ( IORef, modifyIORef, newIORef, readIORef, writeIORef )
-import Data.List ( find, group, intercalate, intersperse, isPrefixOf,
- isSuffixOf, nub, partition, sort, sortBy, (\\) )
+import Data.List ( elemIndices, find, group, intercalate, intersperse,
+ isPrefixOf, isSuffixOf, nub, partition, sort, sortBy, (\\) )
import qualified Data.Set as S
import Data.Maybe
import Data.Map (Map)
@@ -173,7 +173,7 @@ ghciCommands = map mkCmd [
("?", keepGoing help, noCompletion),
("add", keepGoingPaths addModule, completeFilename),
("abandon", keepGoing abandonCmd, noCompletion),
- ("break", keepGoing breakCmd, completeIdentifier),
+ ("break", keepGoing breakCmd, completeBreakpoint),
("back", keepGoing backCmd, noCompletion),
("browse", keepGoing' (browseCmd False), completeModule),
("browse!", keepGoing' (browseCmd True), completeModule),
@@ -3300,7 +3300,7 @@ completeCmd argLine0 = case parseLine argLine0 of
completeGhciCommand, completeMacro, completeIdentifier, completeModule,
completeSetModule, completeSeti, completeShowiOptions,
completeHomeModule, completeSetOptions, completeShowOptions,
- completeHomeModuleOrFile, completeExpression
+ completeHomeModuleOrFile, completeExpression, completeBreakpoint
:: GhciMonad m => CompletionFunc m
-- | Provide completions for last word in a given string.
@@ -3356,6 +3356,68 @@ completeIdentifier line@(left, _) =
dflags <- GHC.getSessionDynFlags
return (filter (w `isPrefixOf`) (map (showPpr dflags) rdrs))
+
+completeBreakpoint = wrapCompleter spaces $ \w -> do -- #17989
+ -- See Note [Tab-completion for :break]
+ -- Pif ~ Pair with Identifier name and File name
+ pifsBreaks <- pifsFromModBreaks
+ pifsInscope <- pifsInscopeByPrefix w
+ pure $ [n | (n,f) <- pifsInscope, (unQual n, f) `elem` pifsBreaks]
+ where
+ -- Extract from the ModBreaks data all the names of top-level
+ -- functions eligible to set breakpoints, and put them
+ -- into a pair together with the filename where they are defined.
+ pifsFromModBreaks :: GhciMonad m => m [(String, FastString)]
+ pifsFromModBreaks = do
+ graph <- GHC.getModuleGraph
+ imods <- filterM GHC.moduleIsInterpreted $
+ ms_mod <$> GHC.mgModSummaries graph
+ topDecls <- mapM pifsFromModBreaksByModule imods
+ pure $ concat topDecls
+
+ -- Return all possible top-level pifs from the ModBreaks
+ -- for one module.
+ -- Identifiers of ModBreaks pifs are never qualified.
+ pifsFromModBreaksByModule :: GhciMonad m => Module -> m [(String, FastString)]
+ pifsFromModBreaksByModule mod = do
+ (_, locs, decls) <- getModBreak mod
+ let mbFile = safeHead $ mapMaybe srcSpanFileName_maybe $ elems locs
+ -- The first element in `decls` is the name of the top-level function.
+ let topLvlDecls = nub $ mapMaybe safeHead $ elems decls
+ pure $ case mbFile of
+ Nothing -> []
+ (Just file) -> zip topLvlDecls $ repeat file
+ where
+ safeHead [] = Nothing
+ safeHead (h : _) = Just h
+
+ -- Return the pifs of all identifieres (RdrNames) in scope, where
+ -- the identifier has the given prefix.
+ -- Identifiers of inscope pifs maybe qualified.
+ pifsInscopeByPrefix :: GhciMonad m => String -> m [(String, FastString)]
+ pifsInscopeByPrefix pref = do
+ dflags <- GHC.getSessionDynFlags
+ rdrs <- GHC.getRdrNamesInScope
+ let strnams = (filter (pref `isPrefixOf`) (map (showPpr dflags) rdrs))
+ nams_fil <- mapM createInscopePif strnams
+ pure $ concat nams_fil
+
+ -- Return a list of pifs for a single in scope identifier
+ createInscopePif :: GhciMonad m => String -> m [(String, FastString)]
+ createInscopePif str_rdr = do
+ names <- GHC.parseName str_rdr
+ let files = mapMaybe srcSpanFileName_maybe $ map nameSrcSpan names
+ pure $ zip (repeat str_rdr) files
+
+ -- unQual "ModLev.Module.func" -> "func"
+ unQual :: String -> String
+ unQual qual_unqual =
+ let ixs = elemIndices '.' qual_unqual
+ in case ixs of
+ [] -> qual_unqual
+ _ -> drop (1 + last ixs) qual_unqual
+
+
completeModule = wrapIdentCompleter $ \w -> do
dflags <- GHC.getSessionDynFlags
let pkg_mods = allVisibleModules dflags
@@ -3437,6 +3499,41 @@ allVisibleModules dflags = listVisibleModuleNames dflags
completeExpression = completeQuotedWord (Just '\\') "\"" listFiles
completeIdentifier
+{-
+Note [Tab-completion for :break]
+--------------------------------
+In tab-completion for the `:break` command, only those
+identifiers should be shown, that are accepted in the
+`:break` command. Hence these identifiers must be
+
+- defined in an interpreted module
+- top-level
+- currently in scope
+- listed in a `ModBreaks` value as a possible breakpoint.
+
+The identifiers may be qualified or unqualified.
+
+To get all possible top-level breakpoints for tab-completeion
+with the correct qualification do:
+
+1. Build the list called `pifsBreaks` of all pairs of
+(Identifier, module-filename) from the `ModBreaks` values.
+Here all identifiers are unqualified.
+
+2. Build the list called `pifInscope` of all pairs of
+(Identifiers, module-filename) with identifiers from
+the `GlobalRdrEnv`. Take only those identifiers that are
+in scope and have the correct prefix.
+Here the identifiers may be qualified.
+
+3. From the `pifInscope` list seclect all pairs that can be
+found in the `pifsBreaks` list, by comparing only the
+unqualified part of the identifier.
+The remaining identifiers can be used for tab-completion.
+
+This ensures, that we show only identifiers, that can be used
+in a `:break` command.
+-}
-- -----------------------------------------------------------------------------
-- commands for debugger
@@ -3703,7 +3800,7 @@ findBreakAndSet :: GhciMonad m
=> Module -> (TickArray -> [(Int, RealSrcSpan)]) -> m ()
findBreakAndSet md lookupTickTree = do
tickArray <- getTickArray md
- (breakArray, _) <- getModBreak md
+ (breakArray, _, _) <- getModBreak md
case lookupTickTree tickArray of
[] -> liftIO $ putStrLn $ "No breakpoints found at that location."
some -> mapM_ (breakAt breakArray) some
@@ -3962,7 +4059,7 @@ getTickArray modl = do
case lookupModuleEnv arrmap modl of
Just arr -> return arr
Nothing -> do
- (_breakArray, ticks) <- getModBreak modl
+ (_breakArray, ticks, _) <- getModBreak modl
let arr = mkTickArray (assocs ticks)
setGHCiState st{tickarrays = extendModuleEnv arrmap modl arr}
return arr
@@ -4001,19 +4098,20 @@ turnBreakOnOff :: GHC.GhcMonad m => Bool -> BreakLocation -> m BreakLocation
turnBreakOnOff onOff loc
| onOff == breakEnabled loc = return loc
| otherwise = do
- (arr, _) <- getModBreak (breakModule loc)
+ (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)
+ => Module -> m (ForeignRef BreakArray, Array Int SrcSpan, Array Int [String])
getModBreak m = do
mod_info <- fromMaybe (panic "getModBreak") <$> GHC.getModuleInfo m
let modBreaks = GHC.modInfoModBreaks mod_info
let arr = GHC.modBreaks_flags modBreaks
let ticks = GHC.modBreaks_locs modBreaks
- return (arr, ticks)
+ let decls = GHC.modBreaks_decls modBreaks
+ return (arr, ticks, decls)
setBreakFlag :: GHC.GhcMonad m => Bool -> ForeignRef BreakArray -> Int -> m ()
setBreakFlag toggle arr i = do
diff --git a/testsuite/tests/ghci.debugger/scripts/T17989.script b/testsuite/tests/ghci.debugger/scripts/T17989.script
new file mode 100644
index 0000000000..86f3f70e93
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T17989.script
@@ -0,0 +1,12 @@
+:l T17989M
+:complete repl ":break "
+-- all listed names are really breakpoints
+:break B.bar
+:break B.foo
+:break T17989A.bar
+:break T17989A.foo
+:break T17989C.foo
+:break foo
+:break main
+:complete repl ":break B."
+:complete repl ":break f"
diff --git a/testsuite/tests/ghci.debugger/scripts/T17989.stdout b/testsuite/tests/ghci.debugger/scripts/T17989.stdout
new file mode 100644
index 0000000000..ce658ace22
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T17989.stdout
@@ -0,0 +1,20 @@
+7 7 ":break "
+"B.bar"
+"B.foo"
+"T17989A.bar"
+"T17989A.foo"
+"T17989C.foo"
+"foo"
+"main"
+Breakpoint 0 activated at T17989B.hs:10:9-25
+Breakpoint 1 activated at T17989B.hs:7:6-11
+Breakpoint 2 activated at T17989A.hs:10:7-13
+Breakpoint 3 activated at T17989A.hs:4:9-14
+Breakpoint 4 activated at T17989C.hs:4:9-26
+Breakpoint 4 was already set at T17989C.hs:4:9-26
+Breakpoint 5 activated at T17989M.hs:6:8-51
+2 2 ":break "
+"B.bar"
+"B.foo"
+1 1 ":break "
+"foo"
diff --git a/testsuite/tests/ghci.debugger/scripts/T17989A.hs b/testsuite/tests/ghci.debugger/scripts/T17989A.hs
new file mode 100644
index 0000000000..32dfef5e85
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T17989A.hs
@@ -0,0 +1,13 @@
+module T17989A (foo, bar) where
+
+foo :: Int -> String
+foo n = x <> y
+ where
+ x = "A.foo-"
+ y = priv n
+
+bar :: String
+bar = "A.bar"
+
+priv :: Int -> String
+priv n = "A.foo-" <> show n
diff --git a/testsuite/tests/ghci.debugger/scripts/T17989B.hs b/testsuite/tests/ghci.debugger/scripts/T17989B.hs
new file mode 100644
index 0000000000..e48067f936
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T17989B.hs
@@ -0,0 +1,13 @@
+module T17989B (foo, bar) where
+
+foo :: Int -> String
+foo n =
+ let x = "B.foo-"
+ y = priv n
+ in x <> y
+
+bar :: Int -> String
+bar n = "B.bar" <> show n
+
+priv :: Int -> String
+priv n = "B.foo-" <> show n
diff --git a/testsuite/tests/ghci.debugger/scripts/T17989C.hs b/testsuite/tests/ghci.debugger/scripts/T17989C.hs
new file mode 100644
index 0000000000..c53471e14d
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T17989C.hs
@@ -0,0 +1,7 @@
+module T17989C (foo) where
+
+foo :: Int -> String
+foo n = "C.foo-" <> priv n
+
+priv :: Int -> String
+priv n = "C.foo-" <> show n
diff --git a/testsuite/tests/ghci.debugger/scripts/T17989M.hs b/testsuite/tests/ghci.debugger/scripts/T17989M.hs
new file mode 100644
index 0000000000..c6d77072c2
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T17989M.hs
@@ -0,0 +1,6 @@
+import qualified T17989A
+import qualified T17989B as B
+import T17989C
+
+main :: IO ()
+main = putStrLn (T17989A.foo 3 <> B.foo 5 <> foo 7)
diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T
index db597a455f..12fe420363 100644
--- a/testsuite/tests/ghci.debugger/scripts/all.T
+++ b/testsuite/tests/ghci.debugger/scripts/all.T
@@ -125,3 +125,4 @@ test('T16700', normal, ghci_script, ['T16700.script'])
test('break029', extra_files(['break029.hs']), ghci_script, ['break029.script'])
test('T2215', normal, ghci_script, ['T2215.script'])
+test('T17989', normal, ghci_script, ['T17989.script'])
View Lorry Controller Status