(module throttle-test mzscheme
(require (lib "list.ss" "srfi" "1")
(lib "comprehensions.ss" "srfi" "42")
(file "test-base.ss")
(file "throttle.ss"))
(provide throttle-tests)
(define (sleep/ms ms)
(sync (alarm-evt (+ (current-inexact-milliseconds) ms))))
(define (make-throttle-suite throttle delay tolerance)
(let ([do-throttle
(lambda (thunk)
(call-with-throttle throttle thunk))])
(test-suite
(format "~ams delay" delay)
(test-case
"First call to throttle happens immediately"
(let ([now (current-inexact-milliseconds)]
[call-time 0])
(do-throttle
(lambda ()
(set! call-time (current-inexact-milliseconds))))
(check-= call-time now tolerance)))
(test-case
(format "Throttled calls are spaced at least ~ams apart" delay)
(let ([times null])
(do-ec (:range x 0 5)
(do-throttle
(lambda ()
(set! times (cons (current-inexact-milliseconds) times)))))
(fold (lambda (curr prev)
(check > (- prev curr) delay)
curr)
(car times)
(cdr times))))
(test-case
(format "Multi-threaded throttled calls are spaced at least ~ams apart" delay)
(let ([times null])
(let* ([channels (map (lambda _ (make-channel)) (iota 5))]
[procs (map (lambda (channel)
(lambda ()
(do-throttle
(lambda ()
(set! times (cons (current-inexact-milliseconds) times))))
(channel-put channel #t)))
channels)])
(for-each thread procs)
(for-each channel-get channels)
(fold (lambda (curr prev)
(check > (- prev curr) delay)
curr)
(car times)
(cdr times)))))
(test-case
(format "Calls more than ~ams apart are not delayed" delay)
(do-throttle
(lambda ()
'foo))
(sleep/ms delay)
(let ([now (current-inexact-milliseconds)]
[call-time 0])
(do-throttle
(lambda ()
(set! call-time (current-inexact-milliseconds))))
(check-= call-time now tolerance)))
(test-case
"Throttle delay is measured from when the thunk finishes execution"
(let ([start1 0]
[start2 0])
(do-throttle
(lambda ()
(set! start1 (current-inexact-milliseconds))
(sleep/ms delay)))
(do-throttle
(lambda ()
(set! start2 (current-inexact-milliseconds))))
(check-= (- start2 start1) (* 2 delay) tolerance)))
)))
(define throttle-tests
(test-suite
"throttle.ss"
(make-throttle-suite (make-throttle 500) 500 50)
(make-throttle-suite (make-throttle 250) 250 50)
(test-case
"throttle-alive? detects when a throttle has been killed with kill-throttle!"
(let ([throttle (make-throttle 1000)])
(check-true (throttle-alive? throttle) "check 1")
(kill-throttle! throttle)
(check-false (throttle-alive? throttle) "check 2")))
(test-case
"throttle-alive? detects when a throttle has been killed via custodian shutdown"
(let ([custodian (make-custodian)])
(let ([throttle (parameterize ([current-custodian custodian])
(make-throttle 1000))])
(check-true (throttle-alive? throttle) "check 1")
(custodian-shutdown-all custodian)
(check-false (throttle-alive? throttle) "check 2"))))
))
)