aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-11-17 10:47:11 +0100
committerLudovic Courtès <ludo@gnu.org>2017-11-17 10:47:49 +0100
commit19fd7229bc668e5b34adc5357557aff3f62b9308 (patch)
treecdd6abe6543dbb84990c4f06e1c792acee6b04da /tests
parent232b3d31016439b5600e47d845ffb7c9a4ee4723 (diff)
downloadgnu-guix-19fd7229bc668e5b34adc5357557aff3f62b9308.tar
gnu-guix-19fd7229bc668e5b34adc5357557aff3f62b9308.tar.gz
workers: Add test with exceptions.
* tests/workers.scm ("exceptions"): New test.
Diffstat (limited to 'tests')
-rw-r--r--tests/workers.scm26
1 files changed, 26 insertions, 0 deletions
diff --git a/tests/workers.scm b/tests/workers.scm
index 44b882f691..4eaefbb43d 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)