[commit: ghc] master: rts: check arguments to flags that don't have any (a20cc3d)

[git at git.haskell.org]

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

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

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

commit a20cc3d00c4ca0753fcdcb16199f173b3af44fe4
Author: Carlos Tomé <carlostome1990 at gmail.com>
Date:   Mon Mar 23 00:53:42 2015 +0100

    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 at gmail.com>
    
    Reviewed By: austin, thomie, hvr
    
    Differential Revision: https://phabricator.haskell.org/D748
    
    GHC Trac Issues: #9839


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

a20cc3d00c4ca0753fcdcb16199f173b3af44fe4
 rts/RtsFlags.c                                     | 35 +++++++++++++++++-----
 .../tests/{ghc-api/T7478/C.hs => rts/T9839_02.hs}  |  0
 .../tests/{ghc-api/T7478/C.hs => rts/T9839_03.hs}  |  0
 testsuite/tests/rts/all.T                          | 13 ++++++++
 4 files changed, 41 insertions(+), 7 deletions(-)

diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c
index 6866700..d7114bf 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/ghc-api/T7478/C.hs b/testsuite/tests/rts/T9839_02.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_02.hs
diff --git a/testsuite/tests/ghc-api/T7478/C.hs b/testsuite/tests/rts/T9839_03.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_03.hs
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
index 86b1bcf..05253fe 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,
+                [''])