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

5 files changed, 40 insertions, 2 deletions

diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c
index 4e23eb8c20..9955518144 100644
--- a/rts/RtsFlags.c
+++ b/rts/RtsFlags.c
@@ -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]);
diff --git a/testsuite/tests/rts/T9839_04.hs b/testsuite/tests/rts/T9839_04.hs
new file mode 100755
index 0000000000..d82a4bd93b
--- /dev/null
+++ b/testsuite/tests/rts/T9839_04.hs
@@ -0,0 +1,4 @@
+module Main where
+
+main :: IO ()
+main = return ()
diff --git a/testsuite/tests/rts/T9839_05.hs b/testsuite/tests/rts/T9839_05.hs
new file mode 100755
index 0000000000..d82a4bd93b
--- /dev/null
+++ b/testsuite/tests/rts/T9839_05.hs
@@ -0,0 +1,4 @@
+module Main where
+
+main :: IO ()
+main = return ()
diff --git a/testsuite/tests/rts/T9839_06.hs b/testsuite/tests/rts/T9839_06.hs
new file mode 100755
index 0000000000..d82a4bd93b
--- /dev/null
+++ b/testsuite/tests/rts/T9839_06.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 71c10d2d0d..8f6137f9d4 100644
--- a/testsuite/tests/rts/all.T
+++ b/testsuite/tests/rts/all.T
@@ -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,
+                [''])