145 lines
2.9 KiB
Scheme
145 lines
2.9 KiB
Scheme
(use-modules (tests)
|
|
(ice-9 atomic)
|
|
(srfi srfi-71)
|
|
(fibers)
|
|
(unit-test)
|
|
(knots)
|
|
(knots thread-pool))
|
|
|
|
(let ((thread-pool
|
|
(make-fixed-size-thread-pool 2)))
|
|
|
|
(assert-equal
|
|
(call-with-thread
|
|
thread-pool
|
|
(lambda ()
|
|
4))
|
|
4))
|
|
|
|
(let ((thread-pool
|
|
(make-fixed-size-thread-pool
|
|
2
|
|
#:thread-initializer (const '(2)))))
|
|
|
|
(assert-equal
|
|
(call-with-thread
|
|
thread-pool
|
|
(lambda (num)
|
|
(* 2 num)))
|
|
4))
|
|
|
|
(let ((thread-pool
|
|
(make-fixed-size-thread-pool 2)))
|
|
|
|
(assert-equal
|
|
#t
|
|
(with-exception-handler
|
|
(lambda (exn)
|
|
(knots-exception? exn))
|
|
(lambda ()
|
|
(call-with-thread
|
|
thread-pool
|
|
(lambda ()
|
|
(+ 1 'a))))
|
|
#:unwind? #t)))
|
|
|
|
(run-fibers-for-tests
|
|
(lambda ()
|
|
(let ((thread-pool
|
|
(make-thread-pool 2)))
|
|
|
|
(assert-equal
|
|
(call-with-thread
|
|
thread-pool
|
|
(lambda ()
|
|
4))
|
|
4))))
|
|
|
|
(run-fibers-for-tests
|
|
(lambda ()
|
|
(let ((thread-pool
|
|
(make-thread-pool
|
|
2
|
|
#:thread-initializer (const '(2)))))
|
|
|
|
(assert-equal
|
|
(call-with-thread
|
|
thread-pool
|
|
(lambda (num)
|
|
(* 2 num)))
|
|
4))))
|
|
|
|
(run-fibers-for-tests
|
|
(lambda ()
|
|
(let ((thread-pool
|
|
(make-thread-pool 2)))
|
|
|
|
(assert-equal
|
|
#t
|
|
(with-exception-handler
|
|
(lambda (exn)
|
|
(knots-exception? exn))
|
|
(lambda ()
|
|
(call-with-thread
|
|
thread-pool
|
|
(lambda ()
|
|
(+ 1 'a))))
|
|
#:unwind? #t)))))
|
|
|
|
(let ((thread-pool
|
|
(make-fixed-size-thread-pool
|
|
1
|
|
#:thread-lifetime 1
|
|
#:thread-initializer
|
|
(lambda ()
|
|
(list (make-atomic-box #t))))))
|
|
|
|
(for-each
|
|
(lambda _
|
|
(call-with-thread
|
|
thread-pool
|
|
(lambda (box)
|
|
(if (atomic-box-ref box)
|
|
(atomic-box-set! box #f)
|
|
(error (atomic-box-ref box))))))
|
|
(iota 10)))
|
|
|
|
(run-fibers-for-tests
|
|
(lambda ()
|
|
(let ((thread-pool
|
|
(make-thread-pool 1 #:thread-lifetime 1)))
|
|
|
|
(for-each
|
|
(lambda _
|
|
(call-with-thread
|
|
thread-pool
|
|
(lambda () #f)))
|
|
(iota 10)))))
|
|
|
|
(let ((thread-pool
|
|
(make-fixed-size-thread-pool
|
|
1
|
|
#:thread-lifetime 2
|
|
#:thread-initializer
|
|
(lambda ()
|
|
(list (make-atomic-box 2))))))
|
|
|
|
(define (ref-and-decrement box)
|
|
(let ((val (atomic-box-ref box)))
|
|
(atomic-box-set! box (- val 1))
|
|
val))
|
|
|
|
(unless (= 2 (call-with-thread
|
|
thread-pool
|
|
ref-and-decrement))
|
|
(error))
|
|
(unless (= 1 (call-with-thread
|
|
thread-pool
|
|
ref-and-decrement))
|
|
(error))
|
|
(unless (= 2 (call-with-thread
|
|
thread-pool
|
|
ref-and-decrement))
|
|
(error)))
|
|
|
|
(display "thread-pool test finished successfully\n")
|