02/07: workers: Add test with exceptions.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 19fd7229bc668e5b34adc5357557aff3f62b9308
Author: Ludovic Courtès <address@hidden>
Date:   Fri Nov 17 10:47:11 2017 +0100

    workers: Add test with exceptions.
    
    * tests/workers.scm ("exceptions"): New test.
---
 tests/workers.scm | 26 ++++++++++++++++++++++++++
 1 file changed, 26 insertions(+)

diff --git a/tests/workers.scm b/tests/workers.scm
index 44b882f..4eaefbb 100644
--- a/tests/workers.scm
+++ b/tests/workers.scm
@@ -42,4 +42,30 @@
         (poll)))
     result))
 
+;; Same as above, but throw exceptions within the workers and make sure they
+;; remain alive.
+(test-equal "exceptions"
+  4242
+  (let* ((pool   (make-pool 10))
+         (result 0)
+         (1+!    (let ((lock (make-mutex)))
+                   (lambda ()
+                     (with-mutex lock
+                       (set! result (+ result 1)))))))
+    (let loop ((i 10))
+      (unless (zero? i)
+        (pool-enqueue! pool (lambda ()
+                              (throw 'whatever)))
+        (loop (- i 1))))
+    (let loop ((i 4242))
+      (unless (zero? i)
+        (pool-enqueue! pool 1+!)
+        (loop (- i 1))))
+    (let poll ()
+      (unless (pool-idle? pool)
+        (pk 'busy result)
+        (sleep 1)
+        (poll)))
+    result))
+
 (test-end)