[commit: ghc] master: rts: fix incorrect checking start for -x arguments (#9839) (75de613)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/75de6131efc780dbdba30fa3fc48c16231ab66a9/ghc

>---------------------------------------------------------------

commit 75de6131efc780dbdba30fa3fc48c16231ab66a9
Author: Nikita Kartashov <snailandmail at gmail.com>
Date:   Mon Jul 6 01:09:26 2015 +0200

    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


>---------------------------------------------------------------

75de6131efc780dbdba30fa3fc48c16231ab66a9
 rts/RtsFlags.c                                         | 18 ++++++++++++++++--
 .../tests/{ghc-api/T7478/C.hs => rts/T9839_04.hs}      |  0
 .../tests/{ghc-api/T7478/C.hs => rts/T9839_05.hs}      |  0
 .../tests/{ghc-api/T7478/C.hs => rts/T9839_06.hs}      |  0
 testsuite/tests/rts/all.T                              | 12 ++++++++++++
 5 files changed, 28 insertions(+), 2 deletions(-)

diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c
index 4e23eb8..9955518 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/ghc-api/T7478/C.hs b/testsuite/tests/rts/T9839_04.hs
old mode 100644
new mode 100755
similarity index 100%
copy from testsuite/tests/ghc-api/T7478/C.hs
copy to testsuite/tests/rts/T9839_04.hs
diff --git a/testsuite/tests/ghc-api/T7478/C.hs b/testsuite/tests/rts/T9839_05.hs
old mode 100644
new mode 100755
similarity index 100%
copy from testsuite/tests/ghc-api/T7478/C.hs
copy to testsuite/tests/rts/T9839_05.hs
diff --git a/testsuite/tests/ghc-api/T7478/C.hs b/testsuite/tests/rts/T9839_06.hs
old mode 100644
new mode 100755
similarity index 100%
copy from testsuite/tests/ghc-api/T7478/C.hs
copy to testsuite/tests/rts/T9839_06.hs
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
index 71c10d2..8f6137f 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,
+                [''])