summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2021-01-05 19:51:07 -0500
committerBen Gamari <ben@smart-cactus.org>2021-01-05 21:24:40 -0500
commit67d94c2baeb037777a907111bf3cddb78b99b1bb (patch)
tree412be75df01269e80c04de75ded29cd61c6eabb5
parent26a928b8fdb1b4ccb75e8edb620b8cf12cb38621 (diff)
downloadhaskell-wip/T19179.tar.gz
testsuite: Increase delay in conc059wip/T19179
As noted in #19179, conc059 can sometimes fail due to too short of a delay in the its Haskell threads. Address this by increasing the delay by an order of magnitude to 5 seconds. While I'm in town I refactored the test to eliminate a great deal of unnecessary platform dependence, eliminate use of the deprecated usleep, and properly handle interruption by signals. Fixes #19179.
-rw-r--r--testsuite/tests/concurrent/should_run/conc059.hs17
-rw-r--r--testsuite/tests/concurrent/should_run/conc059.stdout2
-rw-r--r--testsuite/tests/concurrent/should_run/conc059_c.c44
3 files changed, 37 insertions, 26 deletions
diff --git a/testsuite/tests/concurrent/should_run/conc059.hs b/testsuite/tests/concurrent/should_run/conc059.hs
index 86e202c9a2..823d8b7a03 100644
--- a/testsuite/tests/concurrent/should_run/conc059.hs
+++ b/testsuite/tests/concurrent/should_run/conc059.hs
@@ -13,22 +13,9 @@ import Foreign.C
f :: Int -> IO ()
f x = do
print x
- replicateM_ 10 $ forkIO $ do usleep (fromIntegral x); putStrLn "hello"
+ replicateM_ 10 $ forkIO $ do millisleep (fromIntegral x); putStrLn "hello"
return ()
foreign export ccall "f" f :: Int -> IO ()
-#if defined(mingw32_HOST_OS)
-# if defined(i386_HOST_ARCH)
-# define WINDOWS_CCONV stdcall
-# elif defined(x86_64_HOST_ARCH)
-# define WINDOWS_CCONV ccall
-# else
-# error Unknown mingw32 arch
-# endif
-
-foreign import WINDOWS_CCONV safe "Sleep" _sleep :: Int -> IO ()
-usleep n = _sleep (n `quot` 1000)
-#else
-foreign import ccall safe "usleep" usleep :: Int -> IO ()
-#endif
+foreign import ccall safe "millisleep" millisleep :: CInt -> IO ()
diff --git a/testsuite/tests/concurrent/should_run/conc059.stdout b/testsuite/tests/concurrent/should_run/conc059.stdout
index 961a9d1f26..5c6172b85b 100644
--- a/testsuite/tests/concurrent/should_run/conc059.stdout
+++ b/testsuite/tests/concurrent/should_run/conc059.stdout
@@ -1,3 +1,3 @@
exiting...
-500000
+5000
exited.
diff --git a/testsuite/tests/concurrent/should_run/conc059_c.c b/testsuite/tests/concurrent/should_run/conc059_c.c
index f03615063f..98ac85ecf3 100644
--- a/testsuite/tests/concurrent/should_run/conc059_c.c
+++ b/testsuite/tests/concurrent/should_run/conc059_c.c
@@ -1,29 +1,53 @@
#include "HsFFI.h"
#include "conc059_stub.h"
+#include <stdbool.h>
#include <unistd.h>
#include <stdlib.h>
+#include <errno.h>
#include <stdio.h>
#if mingw32_HOST_OS
#include <windows.h>
#endif
+void millisleep(int milliseconds);
+
int main(int argc, char *argv[])
{
hs_init(&argc,&argv);
- f(500000);
-#if mingw32_HOST_OS
- Sleep(100);
-#else
- usleep(100000);
-#endif
+ f(5000); // this should be considerably longer than the delay on the next
+ // line
+ millisleep(100);
+
printf("exiting...\n");
fflush(stdout);
hs_exit();
printf("exited.\n");
-#if mingw32_HOST_OS
- Sleep(1000);
+ millisleep(1000);
+
+ exit(0);
+}
+
+void millisleep(int milliseconds) {
+#if defined(mingw32_HOST_OS)
+ Sleep(milliseconds);
#else
- usleep(1000000);
+ struct timespec ts = {
+ .tv_sec = milliseconds / 1000,
+ .tv_nsec = (milliseconds % 1000) * 1000000
+ };
+
+ while (true) {
+ int ret = nanosleep(&ts, &ts);
+ if (ret == -1) {
+ if (errno != EINTR) {
+ printf("nanosleep failed\n");
+ exit(1);
+ } else {
+ continue;
+ }
+ } else {
+ return;
+ }
+ }
#endif
- exit(0);
}