gnu: jsoncpp: Update to 1.9.1.
[guix.git] / tests / workers.scm
blob4eaefbb43df67fa085ffee07a76aa976e0629968
1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
3 ;;;
4 ;;; This file is part of GNU Guix.
5 ;;;
6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
7 ;;; under the terms of the GNU General Public License as published by
8 ;;; the Free Software Foundation; either version 3 of the License, or (at
9 ;;; your option) any later version.
10 ;;;
11 ;;; GNU Guix is distributed in the hope that it will be useful, but
12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14 ;;; GNU General Public License for more details.
15 ;;;
16 ;;; You should have received a copy of the GNU General Public License
17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
19 (define-module (test-workers)
20   #:use-module (guix workers)
21   #:use-module (ice-9 threads)
22   #:use-module (srfi srfi-64))
24 (test-begin "workers")
26 (test-equal "enqueue"
27   4242
28   (let* ((pool   (make-pool))
29          (result 0)
30          (1+!    (let ((lock (make-mutex)))
31                    (lambda ()
32                      (with-mutex lock
33                        (set! result (+ result 1)))))))
34     (let loop ((i 4242))
35       (unless (zero? i)
36         (pool-enqueue! pool 1+!)
37         (loop (- i 1))))
38     (let poll ()
39       (unless (pool-idle? pool)
40         (pk 'busy result)
41         (sleep 1)
42         (poll)))
43     result))
45 ;; Same as above, but throw exceptions within the workers and make sure they
46 ;; remain alive.
47 (test-equal "exceptions"
48   4242
49   (let* ((pool   (make-pool 10))
50          (result 0)
51          (1+!    (let ((lock (make-mutex)))
52                    (lambda ()
53                      (with-mutex lock
54                        (set! result (+ result 1)))))))
55     (let loop ((i 10))
56       (unless (zero? i)
57         (pool-enqueue! pool (lambda ()
58                               (throw 'whatever)))
59         (loop (- i 1))))
60     (let loop ((i 4242))
61       (unless (zero? i)
62         (pool-enqueue! pool 1+!)
63         (loop (- i 1))))
64     (let poll ()
65       (unless (pool-idle? pool)
66         (pk 'busy result)
67         (sleep 1)
68         (poll)))
69     result))
71 (test-end)