Escape stats file command (#13676)

4 files changed, 65 insertions, 2 deletions

diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c
index d4301c414f..d36e9ffc66 100644
--- a/rts/RtsFlags.c
+++ b/rts/RtsFlags.c
@@ -1777,16 +1777,30 @@ openStatsFile (char *filename,           // filename, or NULL
  * and the arguments it was invoked with.
 -------------------------------------------------------------------------- */
 
+// stats_fprintf augmented with Bash-compatible escaping. See #13676
+static void stats_fprintf_escape (FILE *f, char*s)
+{
+  stats_fprintf(f, "'");
+  while (*s != '\0') {
+    switch (*s) {
+      case '\'': stats_fprintf(f, "'\\''");  break;
+      default:   stats_fprintf(f, "%c", *s); break;
+    }
+    ++s;
+  }
+  stats_fprintf(f, "' ");
+}
+
 static void initStatsFile (FILE *f)
 {
     /* Write prog_argv and rts_argv into start of stats file */
     int count;
     for (count = 0; count < prog_argc; count++) {
-        stats_fprintf(f, "%s ", prog_argv[count]);
+        stats_fprintf_escape(f, prog_argv[count]);
     }
     stats_fprintf(f, "+RTS ");
     for (count = 0; count < rts_argc; count++)
-        stats_fprintf(f, "%s ", rts_argv[count]);
+        stats_fprintf_escape(f, rts_argv[count]);
     stats_fprintf(f, "\n");
 }
 
diff --git a/testsuite/tests/rts/T13676.hs b/testsuite/tests/rts/T13676.hs
new file mode 100644
index 0000000000..8fdeaed16d
--- /dev/null
+++ b/testsuite/tests/rts/T13676.hs
@@ -0,0 +1,43 @@
+-- T13676 test driver.
+-- Tests that the command dumped by the RTS into the stats file is properly escaped.
+
+module T13676_Driver (GhcPath(GhcPath), test_t13676) where
+
+import Control.Monad
+import Data.Maybe
+
+import System.Exit
+import System.Process
+import System.FilePath
+
+-- This expression contains quotation marks and spaces which must be escaped.
+expr :: String
+expr = "'$' == '\\x0024'"
+
+-- Check that evaluation of expr succeeds.
+check_output :: String -> IO ()
+check_output out =
+  unless (lines out == ["True"]) $
+    exitWith (ExitFailure 13)
+
+-- A name for the .t file.
+tfilename :: String
+tfilename = "T13676.t"
+
+newtype GhcPath = GhcPath FilePath
+
+-- GHC arguments for the initial invocation.
+initial_cmd_args :: [String]
+initial_cmd_args = ["-e", expr, "+RTS", "-t" ++ tfilename]
+
+test_t13676 :: GhcPath -> IO ()
+test_t13676 (GhcPath ghcPath) = do
+  initial_out <- readCreateProcess (proc ghcPath initial_cmd_args) ""
+  check_output initial_out
+  tfile_content <- readFile tfilename
+  dumped_cmd <-
+    case listToMaybe (lines tfile_content) of
+      Nothing -> exitWith (ExitFailure 14)
+      Just str -> return str
+  secondary_out <- readCreateProcess (shell dumped_cmd) ""
+  check_output secondary_out
diff --git a/testsuite/tests/rts/T13676.script b/testsuite/tests/rts/T13676.script
new file mode 100644
index 0000000000..ae5473090a
--- /dev/null
+++ b/testsuite/tests/rts/T13676.script
@@ -0,0 +1,4 @@
+:load T13676.hs
+import System.Environment
+Just ghcPath <- lookupEnv "HC"       -- must be set by the testsuite driver
+test_t13676 (GhcPath ghcPath)
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
index ba5b139efe..2e2709af0d 100644
--- a/testsuite/tests/rts/all.T
+++ b/testsuite/tests/rts/all.T
@@ -393,3 +393,5 @@ test('keep-cafs',
 
 test('T16514', unless(opsys('mingw32'), skip), compile_and_run, ['T16514_c.cpp -lstdc++'])
 test('test-zeroongc', extra_run_opts('-DZ'), compile_and_run, ['-debug'])
+
+test('T13676', [extra_files(['T13676.hs'])], ghci_script, ['T13676.script'])