suzanne.soy/compatibility
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix coroutine API and test to avoid timeout races

Browse Source 
svn: r8900

original commit: b45163183154e038f0736b0c0814157545db0075
This commit is contained in:
Matthew Flatt 2008-03-06 14:08:29 +00:00
parent 349cb92027
commit 0bbfa652f7
2 changed files with 11 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/mzlib/thread.ss
View File

@ -163,7 +163,9 @@
void void
;; Let the co-routine run... ;; Let the co-routine run...
(lambda () (lambda ()
(sync (choice-evt (wrap-evt (alarm-evt (+ timeout (current-inexact-milliseconds))) (sync (choice-evt (wrap-evt (if (evt? timeout)
timeout
(alarm-evt (+ timeout (current-inexact-milliseconds))))
(lambda (x) (lambda (x)
#;(printf "2. alarm-evt~n") #;(printf "2. alarm-evt~n")
(semaphore-wait can-stop-lock) (semaphore-wait can-stop-lock)
@ -208,6 +210,6 @@
(provide coroutine?) (provide coroutine?)
(provide/contract (provide/contract
(coroutine (((any/c . -> . any) . -> . any) . -> . coroutine?)) (coroutine (((any/c . -> . any) . -> . any) . -> . coroutine?))
(coroutine-run (real? coroutine? . -> . boolean?)) (coroutine-run ((or/c evt? real?) coroutine? . -> . boolean?))
(coroutine-result (coroutine? . -> . any)) (coroutine-result (coroutine? . -> . any))
(coroutine-kill (coroutine? . -> . any)))) (coroutine-kill (coroutine? . -> . any))))

13
collects/tests/mzscheme/threadlib.ss
View File

@ -56,18 +56,19 @@
;; coroutines ---------------------------------------- ;; coroutines ----------------------------------------
(define MAX-RUN-TIME 100) ; in msecs
(define cntr 0) (define cntr 0)
(define cntr-sema (make-semaphore))
(define w (coroutine (lambda (enable-stop) (define w (coroutine (lambda (enable-stop)
(let loop ((i 0)) (let loop ((i 0))
(enable-stop #f) (enable-stop #f)
(set! cntr i) (set! cntr i)
(when (= cntr 1)
(semaphore-post cntr-sema))
(enable-stop #t) (enable-stop #t)
(loop (add1 i)))))) (loop (add1 i))))))
(test #t coroutine? w) (test #t coroutine? w)
(test #f coroutine-result w) (test #f coroutine-result w)
(test #f coroutine-run MAX-RUN-TIME w) (test #f coroutine-run cntr-sema w)
(test #t positive? cntr) (test #t positive? cntr)
(test (void) coroutine-kill w) (test (void) coroutine-kill w)
(test #t coroutine-run 100 w) (test #t coroutine-run 100 w)
@ -81,13 +82,13 @@
(set! cntr i) (set! cntr i)
(enable-stop #t) (enable-stop #t)
(loop (sub1 i)))))))) (loop (sub1 i))))))))
(test #t coroutine-run MAX-RUN-TIME w2) (test #t coroutine-run (system-idle-evt) w2)
(test 13 coroutine-result w2) (test 13 coroutine-result w2)
(test #t coroutine-run 100 w2) (test #t coroutine-run 100 w2)
(define w3 (coroutine (lambda (enable-stop) (define w3 (coroutine (lambda (enable-stop)
(raise 14)))) (raise 14))))
(err/rt-test (coroutine-run MAX-RUN-TIME w3) (lambda (x) (eq? x 14))) (err/rt-test (coroutine-run (system-idle-evt) w3) (lambda (x) (eq? x 14)))
(test #f coroutine-result w3) (test #f coroutine-result w3)
(test #t coroutine-run 100 w3) (test #t coroutine-run 100 w3)
@ -95,7 +96,7 @@
(enable-stop #f) (enable-stop #f)
(raise 15)))) (raise 15))))
(test #f coroutine-result w4) (test #f coroutine-result w4)
(err/rt-test (coroutine-run MAX-RUN-TIME w4) (lambda (x) (eq? x 15))) (err/rt-test (coroutine-run (system-idle-evt) w4) (lambda (x) (eq? x 15)))
(test #t coroutine-run 100 w4) (test #t coroutine-run 100 w4)
(report-errs) (report-errs)