mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
workers: Add test with exceptions.
* tests/workers.scm ("exceptions"): New test.
This commit is contained in:
parent
232b3d3101
commit
19fd7229bc
1 changed files with 26 additions and 0 deletions
|
@ -42,4 +42,30 @@ (define-module (test-workers)
|
|||
(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)
|
||||
|
|
Loading…
Reference in a new issue