summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/main/DynFlags.hs8
-rw-r--r--docs/users_guide/phases.rst9
-rw-r--r--docs/users_guide/runtime_control.rst4
-rw-r--r--includes/RtsAPI.h2
-rw-r--r--rts/RtsFlags.c62
-rw-r--r--testsuite/tests/rts/flags/Makefile6
-rw-r--r--testsuite/tests/rts/flags/T12870.hs6
-rw-r--r--testsuite/tests/rts/flags/T12870_.stdout1
-rw-r--r--testsuite/tests/rts/flags/T12870a.stdout1
-rw-r--r--testsuite/tests/rts/flags/T12870c.stderr1
-rw-r--r--testsuite/tests/rts/flags/T12870d.stdout1
-rw-r--r--testsuite/tests/rts/flags/T12870e.stdout1
-rw-r--r--testsuite/tests/rts/flags/T12870f.stdout1
-rw-r--r--testsuite/tests/rts/flags/T12870g.hs8
-rw-r--r--testsuite/tests/rts/flags/T12870g.stdout1
-rw-r--r--testsuite/tests/rts/flags/T12870h.stdout1
-rw-r--r--testsuite/tests/rts/flags/all.T44
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"'])
+
View Lorry Controller Status