[commit: ghc] ghc-8.4: Don't add targets that can't be found in GHCi (8f668bd)
git at git.haskell.org
git at git.haskell.org
Thu Feb 1 04:52:05 UTC 2018
Repository : ssh://git@git.haskell.org/ghc
On branch : ghc-8.4
Link : http://ghc.haskell.org/trac/ghc/changeset/8f668bdaa1909c28a041db1680585bbf7d833987/ghc
>---------------------------------------------------------------
commit 8f668bdaa1909c28a041db1680585bbf7d833987
Author: Julian Priestley <jupriest at devvm610.lla2.facebook.com>
Date: Wed Jan 31 21:35:00 2018 -0500
Don't add targets that can't be found in GHCi
When using the :add command in haxlsh/ghci, a module/file that can't
be found is still added to the list of targets, resulting in an error
message for the bad module/file for every subsequent usage of the
command. The add command should verify that the module/file can be
found before adding it to the list of targets.
Also add a ":show targets" command to show the currently added list of
commands, and an ":unadd" command to remove a target.
Test Plan:
Add a new GHCi testcase that checks that :add doesn't remember either
files or modules that could not be found, and that both the new :show
and :unadd commands work as expected.
Reviewers: simonmar, bgamari
Reviewed By: simonmar
Subscribers: rwbarton, thomie, carter
GHC Trac Issues: #14676
Differential Revision: https://phabricator.haskell.org/D4321
(cherry picked from commit 0bff9e677f0569bc8a7207c20cddddfd67e2448f)
>---------------------------------------------------------------
8f668bdaa1909c28a041db1680585bbf7d833987
ghc/GHCi/UI.hs | 45 +++++++++++++++++++++++++++++-
testsuite/tests/ghci/scripts/T14676.script | 7 +++++
testsuite/tests/ghci/scripts/T14676.stdout | 3 ++
testsuite/tests/ghci/scripts/all.T | 1 +
4 files changed, 55 insertions(+), 1 deletion(-)
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 01c8505..b83ceeb 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -43,6 +43,7 @@ import GHCi.RemoteTypes
import GHCi.BreakArray
import DynFlags
import ErrUtils hiding (traceCmd)
+import Finder
import GhcMonad ( modifySession )
import qualified GHC
import GHC ( LoadHowMuch(..), Target(..), TargetId(..), InteractiveImport(..),
@@ -208,6 +209,7 @@ ghciCommands = map mkCmd [
("stepmodule",keepGoing stepModuleCmd, completeIdentifier),
("type", keepGoing' typeOfExpr, completeExpression),
("trace", keepGoing traceCmd, completeExpression),
+ ("unadd", keepGoingPaths unAddModule, completeFilename),
("undef", keepGoing undefineMacro, completeMacro),
("unset", keepGoing unsetOptions, completeSetOptions),
("where", keepGoing whereCmd, noCompletion)
@@ -305,6 +307,7 @@ defFullHelpText =
" :type <expr> show the type of <expr>\n" ++
" :type +d <expr> show the type of <expr>, defaulting type variables\n" ++
" :type +v <expr> show the type of <expr>, with its specified tyvars\n" ++
+ " :unadd <module> ... remove module(s) from the current target set\n" ++
" :undef <cmd> undefine user-defined command :<cmd>\n" ++
" :!<command> run the shell command <command>\n" ++
"\n" ++
@@ -371,6 +374,7 @@ defFullHelpText =
" :show packages show the currently active package flags\n" ++
" :show paths show the currently active search paths\n" ++
" :show language show the currently active language flags\n" ++
+ " :show targets show the current set of targets\n" ++
" :show <setting> show value of <setting>, which is one of\n" ++
" [args, prog, editor, stop]\n" ++
" :showi language show language flags for interactive evaluation\n" ++
@@ -1657,9 +1661,39 @@ addModule files = do
lift revertCAFs -- always revert CAFs on load/add.
files' <- mapM expandPath files
targets <- mapM (\m -> GHC.guessTarget m Nothing) files'
+ targets' <- filterM checkTarget targets
-- remove old targets with the same id; e.g. for :add *M
+ mapM_ GHC.removeTarget [ tid | Target tid _ _ <- targets' ]
+ mapM_ GHC.addTarget targets'
+ _ <- doLoadAndCollectInfo False LoadAllTargets
+ return ()
+ where
+ checkTarget :: Target -> InputT GHCi Bool
+ checkTarget (Target (TargetModule m) _ _) = checkTargetModule m
+ checkTarget (Target (TargetFile f _) _ _) = liftIO $ checkTargetFile f
+
+ checkTargetModule :: ModuleName -> InputT GHCi Bool
+ checkTargetModule m = do
+ hsc_env <- GHC.getSession
+ result <- liftIO $
+ Finder.findImportedModule hsc_env m (Just (fsLit "this"))
+ case result of
+ Found _ _ -> return True
+ _ -> (liftIO $ putStrLn $
+ "Module " ++ moduleNameString m ++ " not found") >> return False
+
+ checkTargetFile :: String -> IO Bool
+ checkTargetFile f = do
+ exists <- (doesFileExist f) :: IO Bool
+ unless exists $ putStrLn $ "File " ++ f ++ " not found"
+ return exists
+
+-- | @:unadd@ command
+unAddModule :: [FilePath] -> InputT GHCi ()
+unAddModule files = do
+ files' <- mapM expandPath files
+ targets <- mapM (\m -> GHC.guessTarget m Nothing) files'
mapM_ GHC.removeTarget [ tid | Target tid _ _ <- targets ]
- mapM_ GHC.addTarget targets
_ <- doLoadAndCollectInfo False LoadAllTargets
return ()
@@ -2779,6 +2813,7 @@ showCmd str = do
, action "language" $ showLanguages
, hidden "languages" $ showLanguages -- backwards compat
, hidden "lang" $ showLanguages -- useful abbreviation
+ , action "targets" $ showTargets
]
case words str of
@@ -2941,6 +2976,14 @@ showLanguages' show_all dflags =
Nothing -> Just Haskell2010
other -> other
+showTargets :: GHCi ()
+showTargets = mapM_ showTarget =<< GHC.getTargets
+ where
+ showTarget :: Target -> GHCi ()
+ showTarget (Target (TargetFile f _) _ _) = liftIO (putStrLn f)
+ showTarget (Target (TargetModule m) _ _) =
+ liftIO (putStrLn $ moduleNameString m)
+
-- -----------------------------------------------------------------------------
-- Completion
diff --git a/testsuite/tests/ghci/scripts/T14676.script b/testsuite/tests/ghci/scripts/T14676.script
new file mode 100644
index 0000000..9cfe693
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T14676.script
@@ -0,0 +1,7 @@
+:add Notfound.hs
+:add NotFound
+:show targets
+:add prog002/A1.hs
+:show targets
+:unadd prog002/A1.hs
+:show targets
diff --git a/testsuite/tests/ghci/scripts/T14676.stdout b/testsuite/tests/ghci/scripts/T14676.stdout
new file mode 100644
index 0000000..c3e9fbd
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T14676.stdout
@@ -0,0 +1,3 @@
+File Notfound.hs not found
+Module NotFound not found
+prog002/A1.hs
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index e453591..016c482 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -262,3 +262,4 @@ test('T13407', normal, ghci_script, ['T13407.script'])
test('T13963', normal, ghci_script, ['T13963.script'])
test('T14342', [extra_hc_opts("-XOverloadedStrings -XRebindableSyntax")],
ghci_script, ['T14342.script'])
+test('T14676', extra_files(['../prog002']), ghci_script, ['T14676.script'])
More information about the ghc-commits
mailing list