;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (test-workers)
  #:use-module (guix workers)
  #:use-module (ice-9 threads)
  #:use-module (srfi srfi-64))

(test-begin "workers")

(test-equal "enqueue"
  4242
  (let* ((pool   (make-pool))
         (result 0)
         (1+!    (let ((lock (make-mutex)))
                   (lambda ()
                     (with-mutex lock
                       (set! result (+ result 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))

;; 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)
5cb2a76b69'>root</a>/<a href='/guix/log/gnu?id=ad8c40407c2fa5cfd30e1e65b48f8c5cb2a76b69'>gnu</a>/<a href='/guix/log/gnu/packages?id=ad8c40407c2fa5cfd30e1e65b48f8c5cb2a76b69'>packages</a>/<a href='/guix/log/gnu/packages/patchutils.scm?id=ad8c40407c2fa5cfd30e1e65b48f8c5cb2a76b69'>patchutils.scm</a></div><div class='content'><table class='list nowrap'><tr class='nohover'><th class='left'>Age</th><th class='left'>Commit message (<a href='/guix/log/gnu/packages/patchutils.scm?id=ad8c40407c2fa5cfd30e1e65b48f8c5cb2a76b69&amp;showmsg=1'>Expand</a>)</th><th class='left'>Author</th></tr>
<tr><td><span title='2021-03-04 00:45:00 +0100'>2021-03-04</span></td><td><a href='/guix/commit/gnu/packages/patchutils.scm?id=93872098eb4c66c01ee56ba5f0e568e029def326'>gnu: meld: Update to 3.20.3.</a><span class='msg-avail'>...<span class='msg-tooltip'>* gnu/packages/patchutils.scm (meld): Update to 3.20.3.
</span></span></td><td>Tobias Geerinckx-Rice</td></tr>
<tr><td><span title='2021-02-24 09:18:51 +0000'>2021-02-24</span></td><td><a href='/guix/commit/gnu/packages/patchutils.scm?id=5701e85107391733770a76160c77bd0655a4f9c0'>gnu: patchwork: Update to 3.0.1.</a><span class='msg-avail'>...<span class='msg-tooltip'>* gnu/packages/patchutils.scm (patchwork): Update to 3.0.1.
</span></span></td><td>Christopher Baines</td></tr>
<tr><td><span title='2020-12-23 13:23:15 +0000'>2020-12-23</span></td><td><a href='/guix/commit/gnu/packages/patchutils.scm?id=769a7e4b97c9e95c9b7e90bdb6edbc0f226bb5a9'>gnu: patchwork: Update to 3.0.0.</a><span class='msg-avail'>...<span class='msg-tooltip'>* gnu/packages/patchutils.scm (patchwork): Update to 3.0.0.
</span></span></td><td>Christopher Baines</td></tr>
<tr><td><span title='2020-12-13 20:02:28 +0000'>2020-12-13</span></td><td><a href='/guix/commit/gnu/packages/patchutils.scm?id=9a4d1974b2ba03119802fbfdf96806dc103b45bd'>gnu: patchwork: Update to 2.2.3.</a><span class='msg-avail'>...<span class='msg-tooltip'>* gnu/packages/patchutils.scm (patchwork): Update to 2.2.3.
</span></span></td><td>Christopher Baines</td></tr>
<tr><td><span title='2020-10-28 16:53:01 +0000'>2020-10-28</span></td><td><a href='/guix/commit/gnu/packages/patchutils.scm?id=f6839fed5f2052fd257b4af73effb10dcd9bf35b'>gnu: Add pwclient.</a><span class='msg-avail'>...<span class='msg-tooltip'>* gnu/packages/patchutils.scm (pwclient): New variable.
</span></span></td><td>Christopher Baines</td></tr>
<tr><td><span title='2020-09-22 18:42:00 +0200'>2020-09-22</span></td><td><a href='/guix/commit/gnu/packages/patchutils.scm?id=37c24c0bd04b099c7d3ef5a251a453ad12373c0e'>gnu: patchwork: Update to 2.2.2.</a><span class='msg-avail'>...<span class='msg-tooltip'>* gnu/packages/patchutils.scm (patchwork): Update to 2.2.2.
[arguments]: Remove references to 'pwclient' which is now distributed
separately.
</span></span></td><td>Marius Bakke</td></tr>
<tr><td><span title='2020-09-22 18:41:52 +0200'>2020-09-22</span></td><td><a href='/guix/commit/gnu/packages/patchutils.scm?id=ac3103e8f32005e694701f57fe75ea39df8765b7'>gnu: python-django: Update to 3.1.1.</a><span class='msg-avail'>...<span class='msg-tooltip'>* gnu/packages/django.scm (python-django): Update to 3.1.1.
[arguments]: Remove #:modules.  Rename set-tzdir phase to pre-check, and
disable one test.  Adjust PYTHONPATH patching to preserve all entries.  Ensure
the test suite runs sequentially.
[propagated-inputs]: Add PYTHON-ASGIREF.
(python-django-2.2): New public variable.
* gnu/packages/mail.scm (python-hyperkitty)[propagated-inptus]: Change from
PYTHON-DJANGO to PYTHON-DJANGO-2.2.
* gnu/packages/patchutils.scm (patchwork)[propagated-inputs]: Likewise.
</span></span></td><td>Marius Bakke</td></tr>