diff options
-rw-r--r-- | libraries/base/System/Environment.hs | 16 | ||||
-rw-r--r-- | rts/RtsFlags.c | 9 | ||||
-rw-r--r-- | testsuite/tests/rts/T13287/T13287.hs | 4 | ||||
-rw-r--r-- | testsuite/tests/rts/T13287/T13287.stdout | 1 | ||||
-rw-r--r-- | testsuite/tests/rts/T13287/all.T | 4 |
5 files changed, 32 insertions, 2 deletions
diff --git a/libraries/base/System/Environment.hs b/libraries/base/System/Environment.hs index d8b3e03be5..61b728cb9c 100644 --- a/libraries/base/System/Environment.hs +++ b/libraries/base/System/Environment.hs @@ -67,12 +67,24 @@ import System.Environment.ExecutablePath #ifdef mingw32_HOST_OS --- Ignore the arguments to hs_init on Windows for the sake of Unicode compat +{- +Note [Ignore hs_init argv] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +Ignore the arguments to hs_init on Windows for the sake of Unicode compat + +Instead on Windows we get the list of arguments from getCommandLineW and +filter out arguments which the RTS would not have passed along. + +This is done to ensure we get the arguments in proper Unicode Encoding which +the RTS at this moment does not seem provide. The filtering has to match the +one done by the RTS to avoid inconsistencies like #13287. +-} getWin32ProgArgv_certainly :: IO [String] getWin32ProgArgv_certainly = do mb_argv <- getWin32ProgArgv case mb_argv of + -- see Note [Ignore hs_init argv] Nothing -> fmap dropRTSArgs getFullArgs Just argv -> return argv @@ -106,8 +118,10 @@ foreign import ccall unsafe "getWin32ProgArgv" foreign import ccall unsafe "setWin32ProgArgv" c_setWin32ProgArgv :: CInt -> Ptr CWString -> IO () +-- See Note [Ignore hs_init argv] dropRTSArgs :: [String] -> [String] dropRTSArgs [] = [] +dropRTSArgs rest@("--":_) = rest dropRTSArgs ("+RTS":rest) = dropRTSArgs (dropWhile (/= "-RTS") rest) dropRTSArgs ("--RTS":rest) = rest dropRTSArgs ("-RTS":rest) = dropRTSArgs rest diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c index 5fd368cb61..6ab70d4888 100644 --- a/rts/RtsFlags.c +++ b/rts/RtsFlags.c @@ -512,6 +512,13 @@ static void errorRtsOptsDisabled(const char *s) - rtsConfig (global) contains the supplied RtsConfig + On Windows getArgs ignores argv and instead takes the arguments directly + from the WinAPI and removes any which would have been parsed by the RTS. + + If the handling of which arguments are passed to the Haskell side changes + these changes have to be synchronized with getArgs in base. See #13287 and + Note [Ignore hs_init argv] in System.Environment. + -------------------------------------------------------------------------- */ void setupRtsFlags (int *argc, char *argv[], RtsConfig rts_config) @@ -566,7 +573,7 @@ void setupRtsFlags (int *argc, char *argv[], RtsConfig rts_config) // Split arguments (argv) into PGM (argv) and RTS (rts_argv) parts // argv[0] must be PGM argument -- leave in argv - + // for (mode = PGM; arg < total_arg; arg++) { // The '--RTS' argument disables all future +RTS ... -RTS processing. if (strequal("--RTS", argv[arg])) { diff --git a/testsuite/tests/rts/T13287/T13287.hs b/testsuite/tests/rts/T13287/T13287.hs new file mode 100644 index 0000000000..d5b8b430db --- /dev/null +++ b/testsuite/tests/rts/T13287/T13287.hs @@ -0,0 +1,4 @@ +import System.Environment (getArgs) + +main :: IO () +main = getArgs >>= print diff --git a/testsuite/tests/rts/T13287/T13287.stdout b/testsuite/tests/rts/T13287/T13287.stdout new file mode 100644 index 0000000000..d6df8ca157 --- /dev/null +++ b/testsuite/tests/rts/T13287/T13287.stdout @@ -0,0 +1 @@ +["a1","--","a2","+RTS","-RTS","a3"] diff --git a/testsuite/tests/rts/T13287/all.T b/testsuite/tests/rts/T13287/all.T new file mode 100644 index 0000000000..0543e504a8 --- /dev/null +++ b/testsuite/tests/rts/T13287/all.T @@ -0,0 +1,4 @@ +# Ensure that RTS flags past -- get ignored
+
+test('T13287', [extra_run_opts('a1 +RTS -RTS -- a2 +RTS -RTS a3'), omit_ways(['ghci'])], compile_and_run, [''])
+
|