diff options
author | Ludovic Courtès <ludo@gnu.org> | 2017-11-17 10:47:11 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2017-11-17 10:47:49 +0100 |
commit | 19fd7229bc668e5b34adc5357557aff3f62b9308 (patch) | |
tree | cdd6abe6543dbb84990c4f06e1c792acee6b04da /tests | |
parent | 232b3d31016439b5600e47d845ffb7c9a4ee4723 (diff) | |
download | gnu-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.scm | 26 |
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) |