Fix passing spaces to tests on Windows, and add a test for it

1 files changed, 6 insertions, 2 deletions

diff --git a/testsuite/timeout/timeout.hs b/testsuite/timeout/timeout.hs
index ca2eaf7a41..3a709b9f2c 100644
--- a/testsuite/timeout/timeout.hs
+++ b/testsuite/timeout/timeout.hs
@@ -104,12 +104,16 @@ ignoreIOExceptions io = io `catch` ((\_ -> return ()) :: IOException -> IO ())
 
 #else
 run secs cmd =
+    let escape '\\' = "\\\\"
+        escape '"'  = "\\\""
+        escape c    = [c]
+        cmd' = "sh -c \"" ++ concatMap escape cmd ++ "\"" in
     alloca $ \p_startupinfo ->
     alloca $ \p_pi ->
-    withTString ("sh -c \"" ++ cmd ++ "\"") $ \cmd' ->
+    withTString cmd' $ \cmd'' ->
     do job <- createJobObjectW nullPtr nullPtr
        let creationflags = 0
-       b <- createProcessW nullPtr cmd' nullPtr nullPtr True
+       b <- createProcessW nullPtr cmd'' nullPtr nullPtr True
                            creationflags
                            nullPtr nullPtr p_startupinfo p_pi
        unless b $ errorWin "createProcessW"