chibi-scheme/lib/srfi/18/test.sld
Alex Shinn 4e5cdedc03 Converting tests to modules instead of separate programs.
By convention, a library meant for testing exports "run-tests".
Also by convention, assume the test for (foo bar) is (foo bar-test),
keeping the test in the same directory and avoiding confusion since
(chibi test) is not a test for (chibi).
- Avoids the hack of "load"ing test, with resulting namespace complications.
- Allows keeping tests together with the libraries.
- Allows setting up test hooks before running.
- Allows implicit inference of test locations when using above conventions.
2015-04-05 23:38:51 +09:00

114 lines
3.8 KiB
Scheme

(define-library (srfi 18 test)
(export run-tests)
(import (chibi) (srfi 18) (srfi 39) (chibi test))
(begin
(define (run-tests)
(test-begin "srfi-18: threads")
(test "no threads" 'ok (begin 'ok))
(test "unstarted thread" 'ok
(let ((t (make-thread (lambda () (error "oops"))))) 'ok))
(test "ignored thread terminates" 'ok
(let ((t (make-thread (lambda () 'oops)))) (thread-start! t) 'ok))
(test "ignored thread hangs" 'ok
(let ((t (make-thread (lambda () (let lp () (lp))))))
(thread-start! t)
'ok))
(test "joined thread terminates" 'ok
(let ((t (make-thread (lambda () 'oops))))
(thread-start! t)
(thread-join! t)
'ok))
(test "joined thread hangs, timeout" 'timeout
(let ((t (make-thread (lambda () (let lp () (lp))))))
(thread-start! t)
(thread-join! t 0.1 'timeout)))
(test "basic mutex" 'ok
(let ((m (make-mutex)))
(and (mutex? m) 'ok)))
(test "mutex unlock" 'ok
(let ((m (make-mutex)))
(and (mutex-unlock! m) 'ok)))
(test "mutex lock/unlock" 'ok
(let ((m (make-mutex)))
(and (mutex-lock! m)
(mutex-unlock! m)
'ok)))
(test "mutex lock/lock" 'timeout
(let ((m (make-mutex)))
(and (mutex-lock! m)
(if (mutex-lock! m 0.1) 'fail 'timeout))))
(test "mutex lock timeout" 'timeout
(let* ((m (make-mutex))
(t (make-thread (lambda () (mutex-lock! m)))))
(thread-start! t)
(thread-yield!)
(if (mutex-lock! m 0.1) 'fail 'timeout)))
(test "mutex lock/unlock/lock/lock" 'timeout
(let* ((m (make-mutex))
(t (make-thread (lambda () (mutex-unlock! m)))))
(mutex-lock! m)
(thread-start! t)
(if (mutex-lock! m 0.1)
(if (mutex-lock! m 0.1) 'fail-second 'timeout)
'bad-timeout)))
(test "thread-join! end result" 5
(let* ((th (make-thread (lambda () (+ 3 2)))))
(thread-start! th)
(thread-join! th)))
(test-error "thread-join! exception"
(let* ((th (make-thread
(lambda ()
(parameterize ((current-error-port (open-output-string)))
(+ 3 "2"))))))
(thread-start! th)
(thread-join! th)))
(test-assert "make-condition-variable"
(condition-variable? (make-condition-variable)))
(test "condition-variable signal" 'ok
(let* ((mutex (make-mutex))
(cndvar (make-condition-variable))
(th (make-thread
(lambda ()
(if (mutex-unlock! mutex cndvar 0.1) 'ok 'timeout1)))))
(thread-start! th)
(thread-yield!)
(condition-variable-signal! cndvar)
(thread-join! th 0.1 'timeout2)))
(test "condition-variable broadcast" '(ok1 ok2)
(let* ((mutex (make-mutex))
(cndvar (make-condition-variable))
(th1 (make-thread
(lambda ()
(mutex-lock! mutex)
(if (mutex-unlock! mutex cndvar 1.0) 'ok1 'timeout1))))
(th2 (make-thread
(lambda ()
(mutex-lock! mutex)
(if (mutex-unlock! mutex cndvar 1.0) 'ok2 'timeout2)))))
(thread-start! th1)
(thread-start! th2)
(thread-yield!)
(mutex-lock! mutex)
(condition-variable-broadcast! cndvar)
(mutex-unlock! mutex)
(list (thread-join! th1 0.1 'timeout3)
(thread-join! th2 0.1 'timeout4))))
(test-end))))