Add rtsopts ignore and ignoreAll.

These ignore commandline arguments for ignore and commandline as well as
GHCRTS arguments for ignoreAll. Passing RTS flags given on the command
line along to the program by simply skipping processing of these flags
by the RTS.

This fixes #12870.

Test Plan: ./validate

Reviewers: austin, hvr, bgamari, erikd, simonmar

Reviewed By: simonmar

Subscribers: Phyx, rwbarton, thomie

GHC Trac Issues: #12870

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

17 files changed, 129 insertions, 28 deletions

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index cc9bbb8684..e57ea02834 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -1319,7 +1319,9 @@ data DynLibLoader
   | SystemDependent
   deriving Eq
 
-data RtsOptsEnabled = RtsOptsNone | RtsOptsSafeOnly | RtsOptsAll
+data RtsOptsEnabled
+  = RtsOptsNone | RtsOptsIgnore | RtsOptsIgnoreAll | RtsOptsSafeOnly
+  | RtsOptsAll
   deriving (Show)
 
 shouldUseColor :: DynFlags -> Bool
@@ -2835,6 +2837,10 @@ dynamic_flags_deps = [
         (NoArg (setRtsOptsEnabled RtsOptsSafeOnly))
   , make_ord_flag defGhcFlag "rtsopts=none"
         (NoArg (setRtsOptsEnabled RtsOptsNone))
+  , make_ord_flag defGhcFlag "rtsopts=ignore"
+        (NoArg (setRtsOptsEnabled RtsOptsIgnore))
+  , make_ord_flag defGhcFlag "rtsopts=ignoreAll"
+        (NoArg (setRtsOptsEnabled RtsOptsIgnoreAll))
   , make_ord_flag defGhcFlag "no-rtsopts"
         (NoArg (setRtsOptsEnabled RtsOptsNone))
   , make_ord_flag defGhcFlag "no-rtsopts-suggestions"
diff --git a/docs/users_guide/phases.rst b/docs/users_guide/phases.rst
index cefaa8a6d1..074b9499f5 100644
--- a/docs/users_guide/phases.rst
+++ b/docs/users_guide/phases.rst
@@ -740,6 +740,15 @@ for example).
         an error message. If the ``GHCRTS`` environment variable is set,
         then the program will emit a warning message, ``GHCRTS`` will be
         ignored, and the program will run as normal.
+    
+    ``-rtsopts=ignore``
+        Disables all processing of RTS options. Unlike ``none`` this treats
+        all RTS flags appearing on the command line the same way as regular
+        arguments. (Passing them on to your program as arguments).
+        ``GHCRTS`` options will be processed normally.
+
+    ``-rtsopts=ignoreAll``
+        Same as ``ignore`` but also ignores ``GHCRTS``.
 
     ``-rtsopts=some``
         [this is the default setting] Enable only the "safe" RTS
diff --git a/docs/users_guide/runtime_control.rst b/docs/users_guide/runtime_control.rst
index 422eaa2ceb..f141c323f6 100644
--- a/docs/users_guide/runtime_control.rst
+++ b/docs/users_guide/runtime_control.rst
@@ -117,8 +117,8 @@ Setting RTS options with the ``GHCRTS`` environment variable
 
 .. envvar:: GHCRTS
 
-    If the ``-rtsopts`` flag is set to something other than ``none`` when
-    linking, RTS options are also taken from the environment variable
+    If the ``-rtsopts`` flag is set to something other than ``none`` or ``ignoreAll``
+    when linking, RTS options are also taken from the environment variable
     :envvar:`GHCRTS`. For example, to set the maximum heap size to 2G
     for all GHC-compiled programs (using an ``sh``\-like shell):
 
diff --git a/includes/RtsAPI.h b/includes/RtsAPI.h
index 1ed5fb06f0..ca61328b7c 100644
--- a/includes/RtsAPI.h
+++ b/includes/RtsAPI.h
@@ -53,6 +53,8 @@ typedef struct CapabilityPublic_ {
 
 typedef enum {
     RtsOptsNone,         // +RTS causes an error
+    RtsOptsIgnore,       // Ignore command line arguments
+    RtsOptsIgnoreAll,    // Ignore command line and Environment arguments
     RtsOptsSafeOnly,     // safe RTS options allowed; others cause an error
     RtsOptsAll           // all RTS options allowed
   } RtsOptsEnabledEnum;
diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c
index 80bfa56f73..06d59f0550 100644
--- a/rts/RtsFlags.c
+++ b/rts/RtsFlags.c
@@ -615,6 +615,8 @@ void setupRtsFlags (int *argc, char *argv[], RtsConfig rts_config)
 
     // process arguments from the GHCRTS environment variable next
     // (arguments from the command line override these).
+    // If we ignore all non-builtin rtsOpts we skip these.
+    if(rtsConfig.rts_opts_enabled != RtsOptsIgnoreAll)
     {
         char *ghc_rts = getenv("GHCRTS");
 
@@ -631,34 +633,44 @@ void setupRtsFlags (int *argc, char *argv[], RtsConfig rts_config)
         }
     }
 
-    // Split arguments (argv) into PGM (argv) and RTS (rts_argv) parts
-    //   argv[0] must be PGM argument -- leave in argv
-    //
-    for (mode = PGM; arg < total_arg; arg++) {
-        // The '--RTS' argument disables all future +RTS ... -RTS processing.
-        if (strequal("--RTS", argv[arg])) {
 
-            arg++;
-            break;
-        }
-        // The '--' argument is passed through to the program, but
-        // disables all further +RTS ... -RTS processing.
-        else if (strequal("--", argv[arg])) {
-            break;
-        }
-        else if (strequal("+RTS", argv[arg])) {
-            mode = RTS;
-        }
-        else if (strequal("-RTS", argv[arg])) {
-            mode = PGM;
-        }
-        else if (mode == RTS) {
-            appendRtsArg(copyArg(argv[arg]));
-        }
-        else {
-            argv[(*argc)++] = argv[arg];
+    // If we ignore all commandline rtsOpts we skip processing of argv by
+    // the RTS completely
+    if(!(rtsConfig.rts_opts_enabled == RtsOptsIgnoreAll ||
+         rtsConfig.rts_opts_enabled == RtsOptsIgnore)
+    )
+    {
+        // Split arguments (argv) into PGM (argv) and RTS (rts_argv) parts
+        //   argv[0] must be PGM argument -- leave in argv
+        //
+        for (mode = PGM; arg < total_arg; arg++) {
+            // The '--RTS' argument disables all future
+            // +RTS ... -RTS processing.
+            if (strequal("--RTS", argv[arg])) {
+                arg++;
+                break;
+            }
+            // The '--' argument is passed through to the program, but
+            // disables all further +RTS ... -RTS processing.
+            else if (strequal("--", argv[arg])) {
+                break;
+            }
+            else if (strequal("+RTS", argv[arg])) {
+                mode = RTS;
+            }
+            else if (strequal("-RTS", argv[arg])) {
+                mode = PGM;
+            }
+            else if (mode == RTS) {
+                appendRtsArg(copyArg(argv[arg]));
+            }
+            else {
+                argv[(*argc)++] = argv[arg];
+            }
         }
+
     }
+
     // process remaining program arguments
     for (; arg < total_arg; arg++) {
         argv[(*argc)++] = argv[arg];
diff --git a/testsuite/tests/rts/flags/Makefile b/testsuite/tests/rts/flags/Makefile
new file mode 100644
index 0000000000..61900477f9
--- /dev/null
+++ b/testsuite/tests/rts/flags/Makefile
@@ -0,0 +1,6 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+T1791:
+	'$(TEST_HC)' T1791.hs -o T1791 -O -rtsopts
diff --git a/testsuite/tests/rts/flags/T12870.hs b/testsuite/tests/rts/flags/T12870.hs
new file mode 100644
index 0000000000..8d536d58d6
--- /dev/null
+++ b/testsuite/tests/rts/flags/T12870.hs
@@ -0,0 +1,6 @@
+module T12870 where
+
+import System.Environment
+
+main :: IO ()
+main = getArgs >>= putStr . show
diff --git a/testsuite/tests/rts/flags/T12870_.stdout b/testsuite/tests/rts/flags/T12870_.stdout
new file mode 100644
index 0000000000..1b04d8a31c
--- /dev/null
+++ b/testsuite/tests/rts/flags/T12870_.stdout
@@ -0,0 +1 @@
+Heap overflow caught!
diff --git a/testsuite/tests/rts/flags/T12870a.stdout b/testsuite/tests/rts/flags/T12870a.stdout
new file mode 100644
index 0000000000..495a52faf3
--- /dev/null
+++ b/testsuite/tests/rts/flags/T12870a.stdout
@@ -0,0 +1 @@
+["arg1","+RTS","arg2"]
\ No newline at end of file
diff --git a/testsuite/tests/rts/flags/T12870c.stderr b/testsuite/tests/rts/flags/T12870c.stderr
new file mode 100644
index 0000000000..0545774941
--- /dev/null
+++ b/testsuite/tests/rts/flags/T12870c.stderr
@@ -0,0 +1 @@
+T12870c.exe: Most RTS options are disabled. Link with -rtsopts to enable them.

diff --git a/testsuite/tests/rts/flags/T12870d.stdout b/testsuite/tests/rts/flags/T12870d.stdout
new file mode 100644
index 0000000000..495a52faf3
--- /dev/null
+++ b/testsuite/tests/rts/flags/T12870d.stdout
@@ -0,0 +1 @@
+["arg1","+RTS","arg2"]
\ No newline at end of file
diff --git a/testsuite/tests/rts/flags/T12870e.stdout b/testsuite/tests/rts/flags/T12870e.stdout
new file mode 100644
index 0000000000..4859ab454c
--- /dev/null
+++ b/testsuite/tests/rts/flags/T12870e.stdout
@@ -0,0 +1 @@
+["+RTS","-G2","-RTS","arg1","--RTS","+RTS","arg2"]
\ No newline at end of file
diff --git a/testsuite/tests/rts/flags/T12870f.stdout b/testsuite/tests/rts/flags/T12870f.stdout
new file mode 100644
index 0000000000..4859ab454c
--- /dev/null
+++ b/testsuite/tests/rts/flags/T12870f.stdout
@@ -0,0 +1 @@
+["+RTS","-G2","-RTS","arg1","--RTS","+RTS","arg2"]
\ No newline at end of file
diff --git a/testsuite/tests/rts/flags/T12870g.hs b/testsuite/tests/rts/flags/T12870g.hs
new file mode 100644
index 0000000000..e409349827
--- /dev/null
+++ b/testsuite/tests/rts/flags/T12870g.hs
@@ -0,0 +1,8 @@
+module T12870g where
+
+import GHC.RTS.Flags (getGCFlags, generations)
+
+main :: IO ()
+main = do
+    gcFlags <- getGCFlags
+    putStr . show $ generations gcFlags
diff --git a/testsuite/tests/rts/flags/T12870g.stdout b/testsuite/tests/rts/flags/T12870g.stdout
new file mode 100644
index 0000000000..c7930257df
--- /dev/null
+++ b/testsuite/tests/rts/flags/T12870g.stdout
@@ -0,0 +1 @@
+7
\ No newline at end of file
diff --git a/testsuite/tests/rts/flags/T12870h.stdout b/testsuite/tests/rts/flags/T12870h.stdout
new file mode 100644
index 0000000000..e440e5c842
--- /dev/null
+++ b/testsuite/tests/rts/flags/T12870h.stdout
@@ -0,0 +1 @@
+3
\ No newline at end of file
diff --git a/testsuite/tests/rts/flags/all.T b/testsuite/tests/rts/flags/all.T
new file mode 100644
index 0000000000..33a28e500a
--- /dev/null
+++ b/testsuite/tests/rts/flags/all.T
@@ -0,0 +1,44 @@
+#Standard handling of RTS arguments
+test('T12870a',
+    [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs'])],
+    multimod_compile_and_run,
+    ['T12870', '-rtsopts -main-is T12870'])
+
+test('T12870b',
+    [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs']),
+        exit_code(1), ignore_stderr],
+    multimod_compile_and_run,
+    ['T12870', '-rtsopts=none -main-is T12870'])
+
+test('T12870c',
+    [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs']),
+    exit_code(1)],
+    multimod_compile_and_run,
+    ['T12870', '-rtsopts=some -main-is T12870'])
+
+test('T12870d',
+    [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs'])],
+    multimod_compile_and_run,
+    ['T12870', '-main-is T12870'])
+
+#RTS options should be passed along to the program
+test('T12870e',
+    [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs'])],
+    multimod_compile_and_run,
+    ['T12870', '-rtsopts=ignore -main-is T12870'])
+test('T12870f',
+    [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs'])],
+    multimod_compile_and_run,
+    ['T12870', '-rtsopts=ignoreAll -main-is T12870'])
+
+#Check handling of env variables
+test('T12870g',
+    [extra_files(['T12870g.hs']), cmd_prefix('GHCRTS=-G7 '), extra_files(['T12870g.hs'])],
+    multimod_compile_and_run,
+    ['T12870g', '-rtsopts -main-is T12870g -with-rtsopts="-G3"'])
+
+test('T12870h',
+    [extra_files(['T12870g.hs']), cmd_prefix('GHCRTS=-G7 '), extra_files(['T12870g.hs'])],
+    multimod_compile_and_run,
+    ['T12870g', '-rtsopts=ignoreAll -main-is T12870g -with-rtsopts="-G3"'])
+