Commit a20cc3d0 authored by carlostome's avatar carlostome Committed by thomie

rts: check arguments to flags that don't have any

There were some flags of the RTS that when given an argument (which they
don't have) were not firing an error.
e.g -Targument when the flag -T has no argument.
Now this is an error and affects the following flags:
-B -w -T -Z -P -Pa -c -t
Signed-off-by: carlostome's avatarCarlos Tomé <carlostome1990@gmail.com>

Reviewed By: austin, thomie, hvr

Differential Revision: https://phabricator.haskell.org/D748

GHC Trac Issues: #9839
parent 12a03c44
......@@ -791,7 +791,7 @@ error = rtsTrue;
case 'B':
OPTION_UNSAFE;
RtsFlags.GcFlags.ringBell = rtsTrue;
break;
goto check_rest;
case 'c':
OPTION_UNSAFE;
......@@ -806,7 +806,7 @@ error = rtsTrue;
case 'w':
OPTION_UNSAFE;
RtsFlags.GcFlags.sweep = rtsTrue;
break;
goto check_rest;
case 'F':
OPTION_UNSAFE;
......@@ -957,7 +957,7 @@ error = rtsTrue;
case 'T':
OPTION_SAFE;
RtsFlags.GcFlags.giveStats = COLLECT_GC_STATS;
break; /* Don't initialize statistics file. */
goto check_rest; /* Don't initialize statistics file. */
case 'S':
OPTION_SAFE; /* but see below */
......@@ -989,7 +989,7 @@ error = rtsTrue;
case 'Z':
OPTION_UNSAFE;
RtsFlags.GcFlags.squeezeUpdFrames = rtsFalse;
break;
goto check_rest;
/* =========== PROFILING ========================== */
......@@ -1000,8 +1000,14 @@ error = rtsTrue;
switch (rts_argv[arg][2]) {
case 'a':
RtsFlags.CcFlags.doCostCentres = COST_CENTRES_ALL;
if (rts_argv[arg][3] != '\0') {
errorBelch("flag -Pa given an argument"
" when none was expected: %s"
,rts_argv[arg]);
error = rtsTrue;
}
break;
default:
case '\0':
if (rts_argv[arg][1] == 'P') {
RtsFlags.CcFlags.doCostCentres =
COST_CENTRES_VERBOSE;
......@@ -1010,6 +1016,8 @@ error = rtsTrue;
COST_CENTRES_SUMMARY;
}
break;
default:
goto check_rest;
}
) break;
......@@ -1362,14 +1370,14 @@ error = rtsTrue;
PROFILING_BUILD_ONLY(
RtsFlags.ProfFlags.showCCSOnException = rtsTrue;
);
break;
goto check_rest;
case 't': /* Include memory used by TSOs in a heap profile */
OPTION_SAFE;
PROFILING_BUILD_ONLY(
RtsFlags.ProfFlags.includeTSOs = rtsTrue;
);
break;
goto check_rest;
/* The option prefix '-xx' is reserved for future extension. KSW 1999-11. */
......@@ -1388,6 +1396,19 @@ error = rtsTrue;
}
break; /* defensive programming */
/* check the rest to be sure there is nothing afterwards.*/
/* see Trac #9839 */
check_rest:
{
if (rts_argv[arg][2] != '\0') {
errorBelch("flag -%c given an argument"
" when none was expected: %s",
rts_argv[arg][1],rts_argv[arg]);
error = rtsTrue;
}
break;
}
/* =========== OH DEAR ============================ */
default:
OPTION_SAFE;
......
module Main where
main :: IO ()
main = return ()
module Main where
main :: IO ()
main = return ()
......@@ -281,3 +281,16 @@ test('linker_error3',
ignore_output ],
run_command,
['$MAKE -s --no-print-directory linker_error3'])
test('T9839_01', [ no_stdin, ignore_output],
run_command,
['{compiler} -e 1 +RTS -T-s 2>&1 | \
grep "flag -T given an argument when none was expected: -T-s"'])
test('T9839_02', [ only_ways(prof_ways), ignore_output, exit_code(1), extra_run_opts('+RTS -Pax')],
compile_and_run,
[''])
test('T9839_03', [ only_ways(prof_ways), ignore_output, exit_code(1), extra_run_opts('+RTS -Px')],
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