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

compiler/main/DynFlags.hs

@@ -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

ghc/InteractiveUI.hs

@@ -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
 

testsuite/tests/ghci/scripts/Makefile

@@ -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

testsuite/tests/ghci/scripts/T10408A.script

+print "T10408A"

testsuite/tests/ghci/scripts/T10408A.stdout

+"T10408A"
+"T10408B"

testsuite/tests/ghci/scripts/T10408B.script

+print "T10408B"

testsuite/tests/ghci/scripts/T10408B.stdout

+"T10408A"
+"T10408B"

testsuite/tests/ghci/scripts/all.T

@@ -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'])