Make resource pool changes and add parallelism limiter

This was motivated by trying to allow for completely cleaning up
resource pools, which involved removing their use of fiberize which
currently has no destroy mechanism.

As part of this, there's a new parallelism limiter mechanism using
resource pools rather than fibers, and also a fixed size resource
pool.

The tests now drain? and destroy the resource pools to check cleaning
up.

tests/parallelism.scm

@@ -111,4 +111,16 @@
 
      (assert-equal a 1))))
 
+(run-fibers-for-tests
+ (lambda ()
+   (let ((parallelism-limiter (make-parallelism-limiter 2)))
+     (fibers-for-each
+      (lambda _
+        (with-parallelism-limiter
+         parallelism-limiter
+         #f))
+      (iota 50))
+
+     (destroy-parallelism-limiter parallelism-limiter))))
+
 (display "parallelism test finished successfully\n")

tests/resource-pool.scm

@@ -19,7 +19,21 @@
       (number?
        (with-resource-from-pool resource-pool
            res
-         res))))))
+         res)))
+
+     (destroy-resource-pool resource-pool))))
+
+(run-fibers-for-tests
+ (lambda ()
+   (let ((resource-pool (make-fixed-size-resource-pool
+                         (list 1))))
+     (assert-true
+      (number?
+       (with-resource-from-pool resource-pool
+           res
+         res)))
+
+     (destroy-resource-pool resource-pool))))
 
 (run-fibers-for-tests
  (lambda ()
@@ -31,7 +45,9 @@
       (number?
        (with-resource-from-pool resource-pool
            res
-         res))))))
+         res)))
+
+     (destroy-resource-pool resource-pool))))
 
 (let* ((error-constructor
         (record-constructor &resource-pool-timeout))
@@ -88,10 +104,13 @@
           res))
       (iota 20))
 
-     (let loop ((stats (resource-pool-stats resource-pool)))
+     (let loop ((stats (resource-pool-stats resource-pool
+                                            #:timeout #f)))
        (unless (= 0 (assq-ref stats 'resources))
          (sleep 0.1)
-         (loop (resource-pool-stats resource-pool)))))))
+         (loop (resource-pool-stats resource-pool #:timeout #f))))
+
+     (destroy-resource-pool resource-pool))))
 
 (run-fibers-for-tests
  (lambda ()
@@ -115,7 +134,9 @@
                 (set! counter (+ 1 counter))
                 (error "collision detected")))))
       20
-      (iota 50)))))
+      (iota 50))
+
+     (destroy-resource-pool resource-pool))))
 
 (run-fibers-for-tests
  (lambda ()
@@ -129,7 +150,7 @@
                                   (error "collision detected")))
                             (new-number))
                           1
-                          #:default-checkout-timeout 120)))
+                          #:default-checkout-timeout 5)))
      (fibers-batch-for-each
       (lambda _
         (with-resource-from-pool
@@ -140,7 +161,9 @@
                 (set! counter (+ 1 counter))
                 (error "collision detected")))))
       20
-      (iota 50)))))
+      (iota 50))
+
+     (destroy-resource-pool resource-pool))))
 
 (run-fibers-for-tests
  (lambda ()
@@ -164,14 +187,14 @@
                 (call-with-resource-from-pool
                     resource-pool
                   (lambda (res)
-                    (error 'should-not-be-reached))))
+                    #f)))
               #:unwind? #t)))
 
          (while (= 0
                    (assq-ref
-                    (resource-pool-stats resource-pool)
+                    (resource-pool-stats resource-pool #:timeout #f)
                     'waiters))
-           (sleep 0))
+           (sleep 0.1))
 
          (with-exception-handler
              (lambda (exn)
@@ -184,6 +207,8 @@
                  resource-pool
                (lambda (res)
                  (error 'should-not-be-reached))))
-           #:unwind? #t))))))
+           #:unwind? #t)))
+
+     (destroy-resource-pool resource-pool))))
 
 (display "resource-pool test finished successfully\n")