Modify Nmax to maxN Trac #10728

Added test and changed -Nmax to -maxN, -n was taken

Noticed strange -m behavoir and fixed -m from quietly
ignoring being passed invalid opts, e.g. "-msasd"

Reviewers: simonmar, hvr, austin, thomie, bgamari

Reviewed By: hvr, thomie, bgamari

Subscribers: bgamari, hvr, thomie, simonmar

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

GHC Trac Issues: #10728

7 files changed, 100 insertions, 23 deletions

diff --git a/docs/users_guide/7.12.1-notes.rst b/docs/users_guide/7.12.1-notes.rst
index caa1d897a8..678a9778a8 100644
--- a/docs/users_guide/7.12.1-notes.rst
+++ b/docs/users_guide/7.12.1-notes.rst
@@ -40,6 +40,8 @@ The highlights, since the 7.10 branch, are:
 
 - A rewritten (and greatly improved) pattern exhaustiveness checker
 
+- ``-maxN(x)`` added to compliment ``-N``
+
 - GHC can run the interpreter in a separate process (see
   :ref:`external-interpreter`), and the interpreter can now run profiled
   code.
@@ -332,6 +334,9 @@ Runtime system
 
 -  Support for performance monitoring with PAPI has been dropped.
 
+-  ``-maxN(x)`` flag added to compliment ``-N``, it will choose to use at most
+   (x) capabilities, limited by the number of processors as ``-N`` is.
+
 Build system
 ~~~~~~~~~~~~
 
diff --git a/docs/users_guide/using-concurrent.rst b/docs/users_guide/using-concurrent.rst
index 2621afce0f..b2b235ad3e 100644
--- a/docs/users_guide/using-concurrent.rst
+++ b/docs/users_guide/using-concurrent.rst
@@ -110,11 +110,11 @@ There are two ways to run a program on multiple processors: call
 RTS ``-N`` options.
 
 ``-N⟨x⟩``
-``-Nmax⟨x⟩``
+``-maxN⟨x⟩``
 
     .. index::
        single: -N⟨x⟩; RTS option
-       single: -Nmax(x); RTS option
+       single: -maxN(x); RTS option
 
     Use ⟨x⟩ simultaneous threads when running the program.
 
@@ -136,8 +136,9 @@ RTS ``-N`` options.
     value of ⟨x⟩ itself based on how many processors are in your
     machine.
 
-    With Nmax⟨x⟩, i.e. ``+RTS -Nmax3 -RTS``, the runtime will choose at
-    most (x), also limited by the number of processors on the system.
+    With ``-maxN⟨x⟩``, i.e. ``+RTS -maxN3 -RTS``, the runtime will choose
+    at most (x), also limited by the number of processors on the system.
+    Omitting (x) is an error, if you need a default use option ``-N``.
 
     Be careful when using all the processors in your machine: if some of
     your processors are in use by other programs, this can actually harm
diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c
index bd60591f33..56f4420142 100644
--- a/rts/RtsFlags.c
+++ b/rts/RtsFlags.c
@@ -393,7 +393,7 @@ usage_text[] = {
 #if defined(THREADED_RTS) && !defined(NOSMP)
 "  -N[<n>]    Use <n> processors (default: 1, -N alone determines",
 "             the number of processors to use automatically)",
-"  -Nmax[<n>] Use up to n processors automatically",
+"  -maxN[<n>] Use up to <n> processors automatically",
 "  -qg[<n>]  Use parallel GC only for generations >= <n>",
 "            (default: 0, -qg alone turns off parallel GC)",
 "  -qb[<n>]  Use load-balancing in the parallel GC only for generations >= <n>",
@@ -846,14 +846,46 @@ error = rtsTrue;
                   break;
 
               case 'm':
-                  OPTION_UNSAFE;
-                  RtsFlags.GcFlags.pcFreeHeap = atof(rts_argv[arg]+2);
+                /* Case for maxN feature request ticket #10728, it's a little
+                   odd being so far from the N case. */
+#if !defined(NOSMP)
+                if (strncmp("maxN", &rts_argv[arg][1], 4) == 0) {
+                  OPTION_SAFE;
+                  THREADED_BUILD_ONLY(
+                    int nNodes;
+                    int proc = (int)getNumberOfProcessors();
+                    OPTION_SAFE;
+
+                    nNodes = strtol(rts_argv[arg]+5, (char **) NULL, 10);
+                    if (nNodes > proc) { nNodes = proc; }
 
-                  if (RtsFlags.GcFlags.pcFreeHeap < 0 ||
-                      RtsFlags.GcFlags.pcFreeHeap > 100)
+                    if (nNodes <= 0) {
+                      errorBelch("bad value for -maxN");
+                      error = rtsTrue;
+                    }
+#if defined(PROFILING)
+                    RtsFlags.ParFlags.nNodes = 1;
+#else
+                    RtsFlags.ParFlags.nNodes = (nat)nNodes;
+#endif
+                  ) break;
+                } else {
+#endif
+                    OPTION_UNSAFE;
+                    RtsFlags.GcFlags.pcFreeHeap = atof(rts_argv[arg]+2);
+
+                    /* -m was allowing bad flags to go unreported */
+                    if (RtsFlags.GcFlags.pcFreeHeap == 0.0 &&
+                           rts_argv[arg][2] != '0')
                       bad_option( rts_argv[arg] );
-                  break;
 
+                    if (RtsFlags.GcFlags.pcFreeHeap < 0 ||
+                        RtsFlags.GcFlags.pcFreeHeap > 100)
+                        bad_option( rts_argv[arg] );
+                    break;
+#if !defined(NOSMP)
+                }
+#endif
               case 'G':
                   OPTION_UNSAFE;
                   RtsFlags.GcFlags.generations =
@@ -1043,14 +1075,8 @@ error = rtsTrue;
                     int nNodes;
                     OPTION_SAFE; /* but see extra checks below... */
 
-                    // <=n feature request ticket #10728
-                    if (strncmp("max", &rts_argv[arg][2], 3) == 0) {
-                      int proc = (int)getNumberOfProcessors();
-                      nNodes = strtol(rts_argv[arg]+5, (char **) NULL, 10);
-                      if (nNodes > proc) { nNodes = proc; }
-                    } else {
-                      nNodes = strtol(rts_argv[arg]+2, (char **) NULL, 10);
-                    }
+                    nNodes = strtol(rts_argv[arg]+2, (char **) NULL, 10);
+
                     if (nNodes <= 0) {
                       errorBelch("bad value for -N");
                       error = rtsTrue;
diff --git a/testsuite/.gitignore b/testsuite/.gitignore
index 2886400681..e8cb351fcc 100644
--- a/testsuite/.gitignore
+++ b/testsuite/.gitignore
@@ -1389,6 +1389,7 @@ mk/ghcconfig*_test___spaces_ghc*.exe.mk
 /tests/rts/T8242
 /tests/rts/T9045
 /tests/rts/T9078
+/tests/rts/T10728
 /tests/rts/atomicinc
 /tests/rts/bug1010
 /tests/rts/derefnull
diff --git a/testsuite/tests/rts/T10728.hs b/testsuite/tests/rts/T10728.hs
new file mode 100644
index 0000000000..056124d0ca
--- /dev/null
+++ b/testsuite/tests/rts/T10728.hs
@@ -0,0 +1,40 @@
+-- T10728 test case for ``-maxN<n>``
+
+module Main where
+
+import GHC.Conc (getNumProcessors, getNumCapabilities)
+import GHC.Environment
+import Data.Char
+
+main :: IO ()
+main = do
+  -- We're parsing args passed in to make sure things are proper between the
+  -- cli and the program.
+  n <- getN
+
+  c <- getNumCapabilities
+  p <- getNumProcessors
+
+  putStr $ check n c p
+
+-----
+
+check :: Int -> Int -> Int -> String
+check n c p
+  |  n /= 0 && c /= 0 && p /= 0 -- These should never be 0
+  -- Capabilities are equal to n, are they also within processor count?
+  && (n == c && c <= p)
+  -- Capabilities are equal to processor count, are they also within n?
+  || (c == p && c <= n)
+  = "maxN Successful"
+check _n _c _p = "maxN Error"
+
+-- Parsing ``-maxN<n>`` from Args to be sure of it.
+getN :: IO Int
+getN = getFullArgs >>= return . go
+  where
+    go :: [String] -> Int
+    go as = case reads (
+      dropWhile (not . isDigit) . (!! 1) $ as ) :: [(Int, String)] of
+        [x] -> fst x
+        _ -> 0
diff --git a/testsuite/tests/rts/T10728.stdout b/testsuite/tests/rts/T10728.stdout
new file mode 100644
index 0000000000..715329ea3c
--- /dev/null
+++ b/testsuite/tests/rts/T10728.stdout
@@ -0,0 +1 @@
+maxN Successful
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
index 9892050b34..c88bd62267 100644
--- a/testsuite/tests/rts/all.T
+++ b/testsuite/tests/rts/all.T
@@ -1,9 +1,9 @@
 test('testblockalloc',
-     [c_src, only_ways(['normal','threaded1']), extra_run_opts('+RTS -I0')], 
+     [c_src, only_ways(['normal','threaded1']), extra_run_opts('+RTS -I0')],
      compile_and_run, [''])
 
 test('testmblockalloc',
-     [c_src, only_ways(['normal','threaded1']), extra_run_opts('+RTS -I0')], 
+     [c_src, only_ways(['normal','threaded1']), extra_run_opts('+RTS -I0')],
      compile_and_run, [''])
 # -I0 is important: the idle GC will run the memory leak detector,
 # which will crash because the mblocks we allocate are not in a state
@@ -53,7 +53,7 @@ test('divbyzero',
       when(opsys('mingw32'), omit_ways(prof_ways))],
      compile_and_run, [''])
 
-test('outofmem', when(opsys('darwin'), skip), 
+test('outofmem', when(opsys('darwin'), skip),
                  run_command, ['$MAKE -s --no-print-directory outofmem'])
 test('outofmem2', extra_run_opts('+RTS -M5m -RTS'),
                   run_command, ['$MAKE -s --no-print-directory outofmem2'])
@@ -111,8 +111,8 @@ test('T2615',
 
 # omit dyn and profiling ways, because we don't build dyn_l or p_l
 # variants of the RTS by default
-test('traceEvent', [ omit_ways(['dyn'] + prof_ways), 
-                     extra_run_opts('+RTS -ls -RTS') ], 
+test('traceEvent', [ omit_ways(['dyn'] + prof_ways),
+                     extra_run_opts('+RTS -ls -RTS') ],
                    compile_and_run, ['-eventlog'])
 
 test('T4059',
@@ -333,3 +333,6 @@ test('T10590', [ignore_output, when(opsys('mingw32'),skip)], compile_and_run, ['
 # 20000 was easily enough to trigger the bug with 7.10
 test('T10904', [ omit_ways(['ghci']), extra_run_opts('20000') ],
                compile_and_run, ['T10904lib.c'])
+
+test('T10728', [extra_run_opts('+RTS -maxN3 -RTS'), req_smp],
+           compile_and_run, ['-threaded'])