tests/workers.scm

   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/>.
  18
  19 (define-module (test-workers)
  20   #:use-module (guix workers)
  21   #:use-module (ice-9 threads)
  22   #:use-module (srfi srfi-64))
  23
  24 (test-begin "workers")
  25
  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))
  44
  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))
  70
  71 (test-end)