Commit cacba075 authored by Ömer Sinan Ağacan's avatar Ömer Sinan Ağacan Committed by Ben Gamari

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
parent cbdea959
...@@ -1547,15 +1547,22 @@ getSystemDirectories = return [] ...@@ -1547,15 +1547,22 @@ getSystemDirectories = return []
-- given. If the variable does not exist then just return the identity. -- given. If the variable does not exist then just return the identity.
addEnvPaths :: String -> [String] -> IO [String] addEnvPaths :: String -> [String] -> IO [String]
addEnvPaths name list 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 case values of
Nothing -> return list Nothing -> return list
Just arr -> return $ list ++ splitEnv arr Just arr -> return $ list ++ splitEnv working_dir arr
where where
splitEnv :: String -> [String] splitEnv :: FilePath -> String -> [String]
splitEnv value = case break (== envListSep) value of splitEnv working_dir value =
(x, [] ) -> [x] case break (== envListSep) value of
(x, (_:xs)) -> x : splitEnv xs (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) #if defined(mingw32_HOST_OS)
envListSep = ';' envListSep = ';'
#else #else
......
...@@ -174,3 +174,7 @@ T11788: ...@@ -174,3 +174,7 @@ T11788:
.PHONY: T12497 .PHONY: T12497
T12497: T12497:
echo main | "$(TEST_HC)" $(filter-out -rtsopts, $(TEST_HC_OPTS_INTERACTIVE)) T12497.hs 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))
...@@ -382,3 +382,4 @@ test('T12903', [when(opsys('mingw32'), skip)], compile_and_run, ['']) ...@@ -382,3 +382,4 @@ test('T12903', [when(opsys('mingw32'), skip)], compile_and_run, [''])
test('T13832', exit_code(1), compile_and_run, ['-threaded']) test('T13832', exit_code(1), compile_and_run, ['-threaded'])
test('T13894', normal, compile_and_run, ['']) test('T13894', normal, compile_and_run, [''])
test('T14497', normal, compile_and_run, ['-O']) test('T14497', normal, compile_and_run, ['-O'])
test('T14695', normal, run_command, ['$MAKE -s --no-print-directory T14695'])
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