[commit: ghc] master: testsuite: Ensure that hs_try_putmvar003 terminates (a051b55)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/a051b555e32d7d8a08472e36be4cb08716d6d8ad/ghc

>---------------------------------------------------------------

commit a051b555e32d7d8a08472e36be4cb08716d6d8ad
Author: Ben Gamari <bgamari.foss at gmail.com>
Date:   Wed Jul 19 15:06:02 2017 -0400

    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


>---------------------------------------------------------------

a051b555e32d7d8a08472e36be4cb08716d6d8ad
 testsuite/tests/concurrent/should_run/hs_try_putmvar003.hs  |  4 ++--
 testsuite/tests/concurrent/should_run/hs_try_putmvar003_c.c | 10 +++++++---
 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 4442698..d0c9739 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 aa65144..d67ca43 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;
 }