Commit 75de6131 authored by nkartashov's avatar nkartashov Committed by thomie

rts: fix incorrect checking start for -x arguments (#9839)

After previous fix, flag combinations such as -xt and -xc
resulted in an error due to the fact that the checking started from
index 2, which was always 'x' in that case.
Now they are correctly processed.

Differential Revision: https://phabricator.haskell.org/D1039
parent 3fabb71a
......@@ -643,6 +643,7 @@ static void procRtsOpts (int rts_argc0,
{
rtsBool error = rtsFalse;
int arg;
int unchecked_arg_start;
if (!(rts_argc0 < rts_argc)) return;
......@@ -671,7 +672,9 @@ static void procRtsOpts (int rts_argc0,
error = rtsTrue;
} else {
/* 0 is dash, 1 is first letter */
/* see Trac #9839 */
unchecked_arg_start = 1;
switch(rts_argv[arg][1]) {
/* process: general args, then PROFILING-only ones, then
......@@ -820,6 +823,7 @@ error = rtsTrue;
case 'B':
OPTION_UNSAFE;
RtsFlags.GcFlags.ringBell = rtsTrue;
unchecked_arg_start++;
goto check_rest;
case 'c':
......@@ -835,6 +839,7 @@ error = rtsTrue;
case 'w':
OPTION_UNSAFE;
RtsFlags.GcFlags.sweep = rtsTrue;
unchecked_arg_start++;
goto check_rest;
case 'F':
......@@ -1001,6 +1006,7 @@ error = rtsTrue;
case 'T':
OPTION_SAFE;
RtsFlags.GcFlags.giveStats = COLLECT_GC_STATS;
unchecked_arg_start++;
goto check_rest; /* Don't initialize statistics file. */
case 'S':
......@@ -1033,6 +1039,7 @@ error = rtsTrue;
case 'Z':
OPTION_UNSAFE;
RtsFlags.GcFlags.squeezeUpdFrames = rtsFalse;
unchecked_arg_start++;
goto check_rest;
/* =========== PROFILING ========================== */
......@@ -1061,6 +1068,7 @@ error = rtsTrue;
}
break;
default:
unchecked_arg_start++;
goto check_rest;
}
) break;
......@@ -1378,6 +1386,7 @@ error = rtsTrue;
/* =========== EXTENDED OPTIONS =================== */
case 'x': /* Extend the argument space */
unchecked_arg_start++;
switch(rts_argv[arg][2]) {
case '\0':
OPTION_SAFE;
......@@ -1418,6 +1427,7 @@ error = rtsTrue;
PROFILING_BUILD_ONLY(
RtsFlags.ProfFlags.showCCSOnException = rtsTrue;
);
unchecked_arg_start++;
goto check_rest;
case 't': /* Include memory used by TSOs in a heap profile */
......@@ -1425,6 +1435,7 @@ error = rtsTrue;
PROFILING_BUILD_ONLY(
RtsFlags.ProfFlags.includeTSOs = rtsTrue;
);
unchecked_arg_start++;
goto check_rest;
/*
......@@ -1451,7 +1462,10 @@ error = rtsTrue;
/* see Trac #9839 */
check_rest:
{
if (rts_argv[arg][2] != '\0') {
/* start checking from the first unchecked position,
* not from index 2*/
/* see Trac #9839 */
if (rts_argv[arg][unchecked_arg_start] != '\0') {
errorBelch("flag -%c given an argument"
" when none was expected: %s",
rts_argv[arg][1],rts_argv[arg]);
......
module Main where
main :: IO ()
main = return ()
module Main where
main :: IO ()
main = return ()
module Main where
main :: IO ()
main = return ()
......@@ -306,3 +306,15 @@ test('T9839_02', [ only_ways(prof_ways), ignore_output, exit_code(1), extra_run_
test('T9839_03', [ only_ways(prof_ways), ignore_output, exit_code(1), extra_run_opts('+RTS -Px')],
compile_and_run,
[''])
test('T9839_04', [ only_ways(prof_ways), ignore_output, exit_code(0), extra_run_opts('+RTS -xc')],
compile_and_run,
[''])
test('T9839_05', [ only_ways(prof_ways), ignore_output, exit_code(1), extra_run_opts('+RTS -xcx')],
compile_and_run,
[''])
test('T9839_06', [ only_ways(prof_ways), ignore_output, exit_code(1), extra_run_opts('+RTS -xtx')],
compile_and_run,
[''])
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