testsuite: Ensure that hs_try_putmvar003 terminates

Test Plan: Validate

Reviewers: austin, simonmar

Reviewed By: simonmar

Subscribers: simonmar, rwbarton, thomie

GHC Trac Issues: #13434

Differential Revision: https://phabricator.haskell.org/D3724

2 files changed, 9 insertions, 5 deletions

diff --git a/testsuite/tests/concurrent/should_run/hs_try_putmvar003.hs b/testsuite/tests/concurrent/should_run/hs_try_putmvar003.hs
index 44426986b9..d0c973935c 100644
--- a/testsuite/tests/concurrent/should_run/hs_try_putmvar003.hs
+++ b/testsuite/tests/concurrent/should_run/hs_try_putmvar003.hs
@@ -51,7 +51,7 @@ makeExternalCall q = mask_ $ do
 data CallbackQueue
 
 foreign import ccall "mkCallbackQueue"
-  mkCallbackQueue :: Int -> IO (Ptr CallbackQueue)
+  mkCallbackQueue :: Int -> Int -> IO (Ptr CallbackQueue)
 
 foreign import ccall "destroyCallbackQueue"
   destroyCallbackQueue :: Ptr CallbackQueue -> IO ()
@@ -77,7 +77,7 @@ foreign export ccall callbackPutMVar :: StablePtr PrimMVar -> IO ()
 experiment :: Bool -> Int -> Int -> Int -> IO ()
 experiment use_foreign_export x y z = do
   mvars <- replicateM x $ async $ do
-    bracket (mkCallbackQueue (fromEnum use_foreign_export))
+    bracket (mkCallbackQueue (fromEnum use_foreign_export) (z*y))
             destroyCallbackQueue $ \q -> do
       mvars <- replicateM y $ async $
         replicateM_ z $ void $ makeExternalCall q
diff --git a/testsuite/tests/concurrent/should_run/hs_try_putmvar003_c.c b/testsuite/tests/concurrent/should_run/hs_try_putmvar003_c.c
index aa6514407a..d67ca43218 100644
--- a/testsuite/tests/concurrent/should_run/hs_try_putmvar003_c.c
+++ b/testsuite/tests/concurrent/should_run/hs_try_putmvar003_c.c
@@ -9,6 +9,9 @@ struct callback_queue {
     pthread_mutex_t lock;
     pthread_cond_t cond;
     int use_foreign_export;
+    // How many requests will be submitted to this queue?
+    // (e.g. n_threads * n_requests_per_thread)
+    int n_requests;
     struct callback *pending;
 };
 
@@ -24,7 +27,7 @@ void* callback(struct callback_queue *q)
     struct callback *cb;
 
     pthread_mutex_lock(&q->lock);
-    do {
+    for (int i=0; i < q->n_requests; i++) {
         if (q->pending == NULL) {
             pthread_cond_wait(&q->cond,&q->lock);
         }
@@ -39,7 +42,7 @@ void* callback(struct callback_queue *q)
             }
             free(cb);
         }
-    } while (1);
+    }
     pthread_mutex_unlock(&q->lock);
 
     hs_thread_done();
@@ -48,7 +51,7 @@ void* callback(struct callback_queue *q)
 
 typedef void* threadfunc(void *);
 
-struct callback_queue* mkCallbackQueue(int use_foreign_export)
+struct callback_queue* mkCallbackQueue(int use_foreign_export, int n_requests)
 {
     struct callback_queue *q = malloc(sizeof(struct callback_queue));
     pthread_t t;
@@ -56,6 +59,7 @@ struct callback_queue* mkCallbackQueue(int use_foreign_export)
     pthread_cond_init(&q->cond, NULL);
     q->pending = NULL;
     q->use_foreign_export = use_foreign_export;
+    q->n_requests = n_requests;
     pthread_create(&t, NULL, (threadfunc*)callback, q);
     return q;
 }