[Git][ghc/ghc][master] 2 commits: rts: Add Windows-specific implementation of rtsSleep

[Marge Bot]

 Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
cab684f0 by Ben Gamari at 2020-06-04T04:38:36-04:00
rts: Add Windows-specific implementation of rtsSleep

Previously we would use the POSIX path, which uses `nanosleep`. However,
it turns out that `nanosleep` is provided by `libpthread` on Windows. In
general we don't want to incur such a dependency. Avoid this by simply
using `Sleep` on Windows.

Fixes #18272.

- - - - -
ad44b504 by Ben Gamari at 2020-06-04T04:38:36-04:00
compiler: Disable use of process jobs with process < 1.6.9

Due to #17926.

- - - - -


2 changed files:

- compiler/GHC/SysTools/Process.hs
- rts/RtsUtils.c


Changes:

=====================================
compiler/GHC/SysTools/Process.hs
=====================================
@@ -33,13 +33,17 @@ import System.Process
 import GHC.SysTools.FileCleanup
 
 -- | Enable process jobs support on Windows if it can be expected to work (e.g.
--- @process >= 1.6.8.0@).
+-- @process >= 1.6.9.0@).
 enableProcessJobs :: CreateProcess -> CreateProcess
 #if defined(MIN_VERSION_process)
+#if MIN_VERSION_process(1,6,9)
 enableProcessJobs opts = opts { use_process_jobs = True }
 #else
 enableProcessJobs opts = opts
 #endif
+#else
+enableProcessJobs opts = opts
+#endif
 
 -- Similar to System.Process.readCreateProcessWithExitCode, but stderr is
 -- inherited from the parent process, and output to stderr is not captured.
@@ -48,7 +52,7 @@ readCreateProcessWithExitCode'
     -> IO (ExitCode, String)    -- ^ stdout
 readCreateProcessWithExitCode' proc = do
     (_, Just outh, _, pid) <-
-        createProcess proc{ std_out = CreatePipe }
+        createProcess $ enableProcessJobs $ proc{ std_out = CreatePipe }
 
     -- fork off a thread to start consuming the output
     output  <- hGetContents outh
@@ -77,7 +81,7 @@ readProcessEnvWithExitCode
     -> IO (ExitCode, String, String) -- ^ (exit_code, stdout, stderr)
 readProcessEnvWithExitCode prog args env_update = do
     current_env <- getEnvironment
-    readCreateProcessWithExitCode (enableProcessJobs $ proc prog args) {
+    readCreateProcessWithExitCode (proc prog args) {
         env = Just (replaceVar env_update current_env) } ""
 
 -- Don't let gcc localize version info string, #8825


=====================================
rts/RtsUtils.c
=====================================
@@ -156,10 +156,16 @@ reportHeapOverflow(void)
    Sleep for the given period of time.
    -------------------------------------------------------------------------- */
 
-/* Returns -1 on failure but handles EINTR internally.
- * N.B. usleep has been removed from POSIX 2008 */
+/* Returns -1 on failure but handles EINTR internally. On Windows this will
+ * only have millisecond precision. */
 int rtsSleep(Time t)
 {
+#if defined(_WIN32)
+    // N.B. we can't use nanosleep on Windows as it would incur a pthreads
+    // dependency. See #18272.
+    Sleep(TimeToMS(t));
+    return 0;
+#else
     struct timespec req;
     req.tv_sec = TimeToSeconds(t);
     req.tv_nsec = TimeToNS(t - req.tv_sec * TIME_RESOLUTION);
@@ -168,6 +174,7 @@ int rtsSleep(Time t)
         ret = nanosleep(&req, &req);
     } while (ret == -1 && errno == EINTR);
     return ret;
+#endif /* _WIN32 */
 }
 
 /* -----------------------------------------------------------------------------



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c330331adc0a686f24b94844d0eb3a0711b928d7...ad44b50484f27beceab8213a061aa60c7a03f7ca

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c330331adc0a686f24b94844d0eb3a0711b928d7...ad44b50484f27beceab8213a061aa60c7a03f7ca
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200604/725bbc00/attachment-0001.html>