guile-knots/tests/resource-pool.scm

(use-modules (tests)
             (fibers)
             (unit-test)
             (knots parallelism)
             (knots resource-pool))

(define new-number
  (let ((val 0))
    (lambda ()
      (set! val (1+ val))
      val)))

(run-fibers-for-tests
 (lambda ()
   (let ((resource-pool (make-resource-pool
                         new-number
                         1)))
     (assert-true
      (number?
       (with-resource-from-pool resource-pool
           res
         res))))))

(run-fibers-for-tests
 (lambda ()
   (let ((resource-pool (make-resource-pool
                         new-number
                         1
                         #:add-resources-parallelism 1)))
     (assert-true
      (number?
       (with-resource-from-pool resource-pool
           res
         res))))))

(let* ((error-constructor
        (record-constructor &resource-pool-timeout))
       (err
        (error-constructor 'foo)))
  (assert-equal
   (resource-pool-timeout-error-pool err)
   'foo))

(run-fibers-for-tests
 (lambda ()
   (let ((resource-pool (make-resource-pool
                         new-number
                         2)))
     (fibers-for-each
      (lambda _
        (with-resource-from-pool resource-pool
            res
          res))
      (iota 20))

     (destroy-resource-pool resource-pool))))

(run-fibers-for-tests
 (lambda ()
   (let ((resource-pool (make-resource-pool
                         new-number
                         2
                         #:destructor
                         (lambda (res)
                           #t))))
     (fibers-for-each
      (lambda _
        (with-resource-from-pool resource-pool
            res
          res))
      (iota 20))

     (destroy-resource-pool resource-pool))))

(run-fibers-for-tests
 (lambda ()
   (let ((resource-pool (make-resource-pool
                         new-number
                         2
                         #:idle-seconds 0.5
                         #:destructor
                         (lambda (res)
                           #t))))
     (fibers-for-each
      (lambda _
        (with-resource-from-pool resource-pool
            res
          res))
      (iota 20))

     (let loop ((stats (resource-pool-stats resource-pool)))
       (unless (= 0 (assq-ref stats 'resources))
         (sleep 0.1)
         (loop (resource-pool-stats resource-pool)))))))

(run-fibers-for-tests
 (lambda ()
   (let* ((counter 0)
          (resource-pool (make-resource-pool
                          (lambda ()
                            (let ((start-val counter))
                              (sleep 0.05)
                              (if (= start-val counter)
                                  (set! counter (+ 1 counter))
                                  (error "collision detected")))
                            (new-number))
                          1)))
     (fibers-for-each
      (lambda _
        (with-resource-from-pool
         resource-pool res
         (let ((start-val counter))
           (sleep 0.05)
           (if (= start-val counter)
               (set! counter (+ 1 counter))
               (error "collision detected")))))
      (iota 50)))))

(display "resource-pool test finished successfully\n")