utils: Add tests for the resource pool.
* tests/utils.scm: New file. * Makefile.am (TESTS): Add it.
This commit is contained in:
parent
85bcc32bcf
commit
bdcbf01fa5
|
@ -161,7 +161,8 @@ TESTS = \
|
|||
tests/database.scm \
|
||||
tests/http.scm \
|
||||
tests/metrics.scm \
|
||||
tests/remote.scm
|
||||
tests/remote.scm \
|
||||
tests/utils.scm
|
||||
|
||||
# Compiler warning flags.
|
||||
GUILE_WARNINGS = \
|
||||
|
|
|
@ -0,0 +1,65 @@
|
|||
;;; utils.scm -- tests for (cuirass utils) module
|
||||
;;; Copyright © 2023 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of Cuirass.
|
||||
;;;
|
||||
;;; Cuirass 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.
|
||||
;;;
|
||||
;;; Cuirass 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 Cuirass. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(use-modules (cuirass utils)
|
||||
(cuirass logging)
|
||||
(fibers)
|
||||
(fibers channels)
|
||||
(srfi srfi-1)
|
||||
(srfi srfi-64))
|
||||
|
||||
;; Enable debugging output.
|
||||
(current-logging-level 'debug)
|
||||
|
||||
(test-begin "utils")
|
||||
|
||||
(define (resource-pool-test resources consumers)
|
||||
(lambda ()
|
||||
(define channel
|
||||
(make-channel))
|
||||
|
||||
(spawn-fiber
|
||||
(lambda ()
|
||||
(define pool (make-resource-pool (iota resources)))
|
||||
(for-each (lambda (rank)
|
||||
(spawn-fiber
|
||||
(lambda ()
|
||||
(with-resource-from-pool pool resource
|
||||
(put-message channel rank)
|
||||
#t)))
|
||||
#t)
|
||||
(iota consumers))))
|
||||
|
||||
(sort (map (lambda _
|
||||
(get-message channel))
|
||||
(iota consumers))
|
||||
<)))
|
||||
|
||||
(test-equal "resource pool, no contention"
|
||||
(iota 10)
|
||||
(run-fibers (resource-pool-test 10 10)
|
||||
;; XXX: Disable preemption. With Fibers 1.3.1, we get random
|
||||
;; deadlocks on completion (when the 'sort' call above has
|
||||
;; completed) with the default #:hz value.
|
||||
#:hz 0))
|
||||
|
||||
(test-equal "resource pool, contention"
|
||||
(iota 100)
|
||||
(run-fibers (resource-pool-test 10 100)))
|
||||
|
||||
(test-end)
|
Loading…
Reference in New Issue