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 (test-end)