[commit: ghc] master: Linker: ignore empty paths in addEnvPaths (cacba07)

git at git.haskell.org git at git.haskell.org
Fri Jan 26 19:41:23 UTC 2018


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

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

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

commit cacba075d72473511f6924c6505952ff12a20316
Author: Ömer Sinan Ağacan <omeragacan at gmail.com>
Date:   Fri Jan 26 13:09:17 2018 -0500

    Linker: ignore empty paths in addEnvPaths
    
    Previously `splitEnv` worked like this:
    
        > splitEnv "foo:::bar::baz:"
        ["foo","","","bar","","baz",""]
    
    with this patch:
    
        > splitEnv working_dir "foo:::bar:baz:"
        ["foo",working_dir,working_dir"bar","baz",working_dir]
    
    This fixes #14695, where having a trailing `:` in the env variable
    caused ghci to pass empty `-B` parameter to `gcc`, which in turned
    caused the next parameter (`--print-file-name`) to be considered as the
    argument to `-B`. As a result ghci did not work.
    
    The `working_dir` argument is to have a similar behavior with POSIX:
    according to chapter 8.3 zero-length prefix means current working
    directory.
    
    Reviewers: hvr, bgamari, AndreasK, simonmar
    
    Reviewed By: bgamari, AndreasK, simonmar
    
    Subscribers: AndreasK, rwbarton, thomie, carter
    
    GHC Trac Issues: #14695
    
    Differential Revision: https://phabricator.haskell.org/D4330


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

cacba075d72473511f6924c6505952ff12a20316
 compiler/ghci/Linker.hs      | 19 +++++++++++++------
 testsuite/tests/rts/Makefile |  4 ++++
 testsuite/tests/rts/all.T    |  1 +
 3 files changed, 18 insertions(+), 6 deletions(-)

diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs
index 3481379..a91df32 100644
--- a/compiler/ghci/Linker.hs
+++ b/compiler/ghci/Linker.hs
@@ -1547,15 +1547,22 @@ getSystemDirectories = return []
 --   given. If the variable does not exist then just return the identity.
 addEnvPaths :: String -> [String] -> IO [String]
 addEnvPaths name list
-  = do values <- lookupEnv name
+  = do -- According to POSIX (chapter 8.3) a zero-length prefix means current
+       -- working directory. Replace empty strings in the env variable with
+       -- `working_dir` (see also #14695).
+       working_dir <- getCurrentDirectory
+       values <- lookupEnv name
        case values of
          Nothing  -> return list
-         Just arr -> return $ list ++ splitEnv arr
+         Just arr -> return $ list ++ splitEnv working_dir arr
     where
-      splitEnv :: String -> [String]
-      splitEnv value = case break (== envListSep) value of
-                         (x, []    ) -> [x]
-                         (x, (_:xs)) -> x : splitEnv xs
+      splitEnv :: FilePath -> String -> [String]
+      splitEnv working_dir value =
+        case break (== envListSep) value of
+          (x, []    ) ->
+            [if null x then working_dir else x]
+          (x, (_:xs)) ->
+            (if null x then working_dir else x) : splitEnv working_dir xs
 #if defined(mingw32_HOST_OS)
       envListSep = ';'
 #else
diff --git a/testsuite/tests/rts/Makefile b/testsuite/tests/rts/Makefile
index a6d2482..ded3be1 100644
--- a/testsuite/tests/rts/Makefile
+++ b/testsuite/tests/rts/Makefile
@@ -174,3 +174,7 @@ T11788:
  .PHONY: T12497
 T12497:
 	echo main | "$(TEST_HC)" $(filter-out -rtsopts, $(TEST_HC_OPTS_INTERACTIVE)) T12497.hs
+
+.PHONY: T14695
+T14695:
+	echo ":quit" | LD_LIBRARY_PATH="foo:" "$(TEST_HC)" $(filter-out -rtsopts, $(TEST_HC_OPTS_INTERACTIVE))
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
index 6377bde..fe86dd1 100644
--- a/testsuite/tests/rts/all.T
+++ b/testsuite/tests/rts/all.T
@@ -382,3 +382,4 @@ test('T12903', [when(opsys('mingw32'), skip)], compile_and_run, [''])
 test('T13832', exit_code(1), compile_and_run, ['-threaded'])
 test('T13894', normal, compile_and_run, [''])
 test('T14497', normal, compile_and_run, ['-O'])
+test('T14695', normal, run_command, ['$MAKE -s --no-print-directory T14695'])



More information about the ghc-commits mailing list