Commit f5188f3a authored by Zejun Wu's avatar Zejun Wu Committed by Austin Seipp

Fix weird behavior of -ignore-dot-ghci and -ghci-scipt

 * Make `-ghci-script` be executed in the order they are specified;
 * Make `-ignore-dot-ghci` only ignores the default .ghci files but
   still execute the scripts passed by `-ghci-script`.

Reviewed By: simonmar, austin

Differential Revision: https://phabricator.haskell.org/D887

GHC Trac Issues: #10408
parent ca7c8550
......@@ -840,6 +840,8 @@ data DynFlags = DynFlags {
flushErr :: FlushErr,
haddockOptions :: Maybe String,
-- | GHCi scripts specified by -ghci-script, in reverse order
ghciScripts :: [String],
-- Output style options
......
......@@ -463,7 +463,7 @@ runGHCi :: [(FilePath, Maybe Phase)] -> Maybe [String] -> GHCi ()
runGHCi paths maybe_exprs = do
dflags <- getDynFlags
let
read_dot_files = not (gopt Opt_IgnoreDotGhci dflags)
ignore_dot_ghci = gopt Opt_IgnoreDotGhci dflags
current_dir = return (Just ".ghci")
......@@ -481,45 +481,35 @@ runGHCi paths maybe_exprs = do
canonicalizePath' fp = liftM Just (canonicalizePath fp)
`catchIO` \_ -> return Nothing
sourceConfigFile :: (FilePath, Bool) -> GHCi ()
sourceConfigFile (file, check_perms) = do
sourceConfigFile :: FilePath -> GHCi ()
sourceConfigFile file = do
exists <- liftIO $ doesFileExist file
when exists $ do
perms_ok <-
if not check_perms
then return True
else do
dir_ok <- liftIO $ checkPerms (getDirectory file)
file_ok <- liftIO $ checkPerms file
return (dir_ok && file_ok)
when perms_ok $ do
either_hdl <- liftIO $ tryIO (openFile file ReadMode)
case either_hdl of
Left _e -> return ()
-- NOTE: this assumes that runInputT won't affect the terminal;
-- can we assume this will always be the case?
-- This would be a good place for runFileInputT.
Right hdl ->
do runInputTWithPrefs defaultPrefs defaultSettings $
runCommands $ fileLoop hdl
liftIO (hClose hdl `catchIO` \_ -> return ())
where
getDirectory f = case takeDirectory f of "" -> "."; d -> d
either_hdl <- liftIO $ tryIO (openFile file ReadMode)
case either_hdl of
Left _e -> return ()
-- NOTE: this assumes that runInputT won't affect the terminal;
-- can we assume this will always be the case?
-- This would be a good place for runFileInputT.
Right hdl ->
do runInputTWithPrefs defaultPrefs defaultSettings $
runCommands $ fileLoop hdl
liftIO (hClose hdl `catchIO` \_ -> return ())
--
setGHCContextFromGHCiState
when (read_dot_files) $ do
mcfgs0 <- catMaybes <$> sequence [ current_dir, app_user_dir, home_dir ]
let mcfgs1 = zip mcfgs0 (repeat True)
++ zip (ghciScripts dflags) (repeat False)
-- False says "don't check permissions". We don't
-- require that a script explicitly added by
-- -ghci-script is owned by the current user. (#6017)
mcfgs <- liftIO $ mapM (\(f, b) -> (,b) <$> canonicalizePath' f) mcfgs1
mapM_ sourceConfigFile $ nub $ [ (f,b) | (Just f, b) <- mcfgs ]
-- nub, because we don't want to read .ghci twice if the
-- CWD is $HOME.
dot_cfgs <- if ignore_dot_ghci then return [] else do
dot_files <- catMaybes <$> sequence [ current_dir, app_user_dir, home_dir ]
liftIO $ filterM checkDirAndFilePerms dot_files
let arg_cfgs = reverse $ ghciScripts dflags
-- -ghci-script are collected in reverse order
mcfgs <- liftIO $ mapM canonicalizePath' $ dot_cfgs ++ arg_cfgs
-- We don't require that a script explicitly added by -ghci-script
-- is owned by the current user. (#6017)
mapM_ sourceConfigFile $ nub $ catMaybes mcfgs
-- nub, because we don't want to read .ghci twice if the CWD is $HOME.
-- Perform a :load for files given on the GHCi command line
-- When in -e mode, if the load fails then we want to stop
......@@ -540,7 +530,7 @@ runGHCi paths maybe_exprs = do
let show_prompt = verbosity dflags > 0 || is_tty
-- reset line number
getGHCiState >>= \st -> setGHCiState st{line_number=1}
modifyGHCiState $ \st -> st{line_number=1}
case maybe_exprs of
Nothing ->
......@@ -599,13 +589,23 @@ nextInputLine show_prompt is_tty
-- don't need to check .. and ../.. etc. because "." always refers to
-- the same directory while a process is running.
checkPerms :: String -> IO Bool
checkDirAndFilePerms :: FilePath -> IO Bool
checkDirAndFilePerms file = do
dir_ok <- checkPerms $ getDirectory file
file_ok <- checkPerms file
return (dir_ok && file_ok)
where
getDirectory f = case takeDirectory f of
"" -> "."
d -> d
checkPerms :: FilePath -> IO Bool
#ifdef mingw32_HOST_OS
checkPerms _ = return True
#else
checkPerms name =
checkPerms file =
handleIO (\_ -> return False) $ do
st <- getFileStatus name
st <- getFileStatus file
me <- getRealUserID
let mode = System.Posix.fileMode st
ok = (fileOwner st == me || fileOwner st == 0) &&
......@@ -613,9 +613,9 @@ checkPerms name =
otherWriteMode /= mode `intersectFileModes` otherWriteMode
unless ok $
-- #8248: Improving warning to include a possible fix.
putStrLn $ "*** WARNING: " ++ name ++
putStrLn $ "*** WARNING: " ++ file ++
" is writable by someone else, IGNORING!" ++
"\nSuggested fix: execute 'chmod 644 " ++ name ++ "'"
"\nSuggested fix: execute 'chmod 644 " ++ file ++ "'"
return ok
#endif
......
......@@ -47,3 +47,13 @@ T9367:
.PHONY: T9762_prep
T9762_prep:
'$(TEST_HC)' $(TEST_HC_OPTS) -O -fhpc -dynamic T9762B.hs
.PHONY: T10408A
T10408A:
'$(TEST_HC)' $(TEST_HC_OPTS) --interactive -v0 \
-ghci-script T10408A.script -ghci-script T10408B.script < /dev/null
.PHONY: T10408B
T10408B:
'$(TEST_HC)' $(TEST_HC_OPTS) --interactive -v0 -ignore-dot-ghci \
-ghci-script T10408A.script -ghci-script T10408B.script < /dev/null
......@@ -211,3 +211,8 @@ test('T10322', when(opsys('darwin'), expect_broken(10322)),
ghci_script, ['T10322.script'])
test('T10321', normal, ghci_script, ['T10321.script'])
test('T10408A', normal, run_command,
['$MAKE -s --no-print-directory T10408A'])
test('T10408B', normal, run_command,
['$MAKE -s --no-print-directory T10408B'])
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