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: Carlos Tomé <carlostome1990@gmail.com>

Reviewed By: austin, thomie, hvr

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

GHC Trac Issues: #9839

4 files changed, 49 insertions, 7 deletions

diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c
index 68667005f0..d7114bf88b 100644
--- a/rts/RtsFlags.c
+++ b/rts/RtsFlags.c
@@ -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;
diff --git a/testsuite/tests/rts/T9839_02.hs b/testsuite/tests/rts/T9839_02.hs
new file mode 100755
index 0000000000..d82a4bd93b
--- /dev/null
+++ b/testsuite/tests/rts/T9839_02.hs
@@ -0,0 +1,4 @@
+module Main where
+
+main :: IO ()
+main = return ()
diff --git a/testsuite/tests/rts/T9839_03.hs b/testsuite/tests/rts/T9839_03.hs
new file mode 100755
index 0000000000..d82a4bd93b
--- /dev/null
+++ b/testsuite/tests/rts/T9839_03.hs
@@ -0,0 +1,4 @@
+module Main where
+
+main :: IO ()
+main = return ()
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
index 86b1bcf162..05253fe1b6 100644
--- a/testsuite/tests/rts/all.T
+++ b/testsuite/tests/rts/all.T
@@ -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,
+                [''])