workers: Add test with exceptions.

* tests/workers.scm ("exceptions"): New test.
This commit is contained in:
Ludovic Courtès 2017-11-17 10:47:11 +01:00
parent 232b3d3101
commit 19fd7229bc
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 26 additions and 0 deletions

View File

@ -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)