[commit: ghc] master: Do not check dir perms when .ghci doesn't exist (3ef7fce)

git at git.haskell.org git at git.haskell.org
Thu May 14 21:26:08 UTC 2015


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/3ef7fcedfa1ad47968ca5fa107d51a6ab7051ed7/ghc

>---------------------------------------------------------------

commit 3ef7fcedfa1ad47968ca5fa107d51a6ab7051ed7
Author: Zejun Wu <watashi at watashi.ws>
Date:   Thu May 14 10:56:51 2015 -0500

    Do not check dir perms when .ghci doesn't exist
    
    Do not check dir perms when .ghci doesn't exist, otherwise GHCi will
    print some confusing and useless warnings in some cases (e.g. in travis).
    This will fix test T8333 and T10408A in travis.
    
    T10408A will be a test case to cover this. And T8333 is changed to be
    not affected by this.
    
    Test Plan:
      chmod o+w ~/.ghc
      make TESTS="T8333 T10408A T10408B"
      chmod o-w ~/.ghc
    
    Reviewers: austin, nomeata
    
    Differential Revision: https://phabricator.haskell.org/D890


>---------------------------------------------------------------

3ef7fcedfa1ad47968ca5fa107d51a6ab7051ed7
 ghc/InteractiveUI.hs        | 9 ++++-----
 testsuite/tests/th/Makefile | 2 +-
 2 files changed, 5 insertions(+), 6 deletions(-)

diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index 77f65eb..70e4df1 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -502,7 +502,7 @@ runGHCi paths maybe_exprs = do
 
   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
+    liftIO $ filterM checkFileAndDirPerms dot_files
   let arg_cfgs = reverse $ ghciScripts dflags
     -- -ghci-script are collected in reverse order
   mcfgs <- liftIO $ mapM canonicalizePath' $ dot_cfgs ++ arg_cfgs
@@ -589,11 +589,10 @@ nextInputLine show_prompt is_tty
 -- don't need to check .. and ../.. etc. because "."  always refers to
 -- the same directory while a process is running.
 
-checkDirAndFilePerms :: FilePath -> IO Bool
-checkDirAndFilePerms file = do
-  dir_ok <- checkPerms $ getDirectory file
+checkFileAndDirPerms :: FilePath -> IO Bool
+checkFileAndDirPerms file = do
   file_ok <- checkPerms file
-  return (dir_ok && file_ok)
+  if file_ok then checkPerms (getDirectory file) else return False
   where
   getDirectory f = case takeDirectory f of
     "" -> "."
diff --git a/testsuite/tests/th/Makefile b/testsuite/tests/th/Makefile
index d10476e..031c285 100644
--- a/testsuite/tests/th/Makefile
+++ b/testsuite/tests/th/Makefile
@@ -36,7 +36,7 @@ TH_Depends:
 
 
 T8333:
-	'$(TEST_HC)' $(TEST_HC_OPTS) $(ghcThWayFlags) --interactive -v0 T8333.hs < /dev/null
+	'$(TEST_HC)' $(TEST_HC_OPTS) $(ghcThWayFlags) --interactive -v0 -ignore-ghci-script T8333.hs < /dev/null
 
 # This was an easy way to re-use the stdout testing
 # to check the contents of a generated file.



More information about the ghc-commits mailing list