Fix the destroy behaviour for fixed size thread pools

destroy-thread-pool should block until the thread pool has been
destroyed.

knots/thread-pool.scm

@@ -163,12 +163,13 @@ from there, or #f if that would be an empty string."
 
 (define-record-type <fixed-size-thread-pool>
   (fixed-size-thread-pool channel arguments-parameter current-procedures
-                          default-checkout-timeout)
+                          default-checkout-timeout threads)
   fixed-size-thread-pool?
   (channel             fixed-size-thread-pool-channel)
   (arguments-parameter fixed-size-thread-pool-arguments-parameter)
   (current-procedures  fixed-size-thread-pool-current-procedures)
-  (default-checkout-timeout fixed-size-thread-pool-default-checkout-timeout))
+  (default-checkout-timeout fixed-size-thread-pool-default-checkout-timeout)
+  (threads             fixed-size-thread-pool-threads))
 
 ;; Since both thread pool records have this field, use a procedure
 ;; than handles the appropriate accessor
@@ -426,19 +427,20 @@ completes.
                        (initializer/safe)
                        '()))))))))
 
-  (for-each
-   (lambda (i)
-     (if use-default-io-waiters?
-         (call-with-default-io-waiters
-          (lambda ()
-            (start-thread i channel)))
-         (start-thread i channel)))
-   (iota size))
+  (define threads
+    (map (lambda (i)
+           (if use-default-io-waiters?
+               (call-with-default-io-waiters
+                (lambda ()
+                  (start-thread i channel)))
+               (start-thread i channel)))
+         (iota size)))
 
   (fixed-size-thread-pool channel
                           param
                           thread-proc-vector
-                          default-checkout-timeout))
+                          default-checkout-timeout
+                          threads))
 
 (define* (make-thread-pool max-size
                            #:key
@@ -627,9 +629,13 @@ Override the channel used to communicate with the thread.
                     destroy-thread-on-exception?))))))))
 
 (define (destroy-thread-pool pool)
+  "Destroy POOL, stopping all of its threads and calling the destructor
+if specified.  This procedure will block until the destruction is
+complete."
   (if (fixed-size-thread-pool? pool)
-      (put-message
-       (fixed-size-thread-pool-channel pool)
-       'destroy)
+      (let ((channel (fixed-size-thread-pool-channel pool))
+            (threads (fixed-size-thread-pool-threads pool)))
+        (for-each (lambda _ (put-message channel 'destroy)) threads)
+        (for-each join-thread threads))
       (destroy-resource-pool
        (thread-pool-resource-pool pool))))