suzanne.soy/racket
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
This commit is contained in:
Matthew Flatt 2008-03-06 14:08:29 +00:00
parent e66ea1084c
commit b451631831
5 changed files with 19 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/mzlib/scribblings/thread.scrbl
View File

@ -30,13 +30,14 @@ Returns @scheme[#t] if @scheme[v] is a coroutine produced by
@scheme[coroutine], @scheme[#f] otherwise.}
@defproc[(coroutine-run [timeout-secs real?][coroutine coroutine?])
@defproc[(coroutine-run [until (or/c evt? real?)][coroutine coroutine?])
boolean?]{
Allows the thread associated with @scheme[coroutine] to execute for up
to @scheme[timeout-secs]. If @scheme[coroutine]'s procedure disables
suspends, then the coroutine can run arbitrarily long until it
re-enables suspends.
as long as @scheme[until] milliseconds (of @scheme[until] is a real
number) or @scheme[until] is ready (if @scheme[until] is an event). If
@scheme[coroutine]'s procedure disables suspends, then the coroutine
can run arbitrarily long until it re-enables suspends.
The @scheme[coroutine-run] procedure returns @scheme[#t] if
@scheme[coroutine]'s procedure completes (or if it completed earlier),

6
collects/mzlib/thread.ss
View File

@ -163,7 +163,9 @@
void
;; Let the co-routine run...
(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)
#;(printf "2. alarm-evt~n")
(semaphore-wait can-stop-lock)
@ -208,6 +210,6 @@
(provide coroutine?)
(provide/contract
(coroutine (((any/c . -> . any) . -> . any) . -> . coroutine?))
(coroutine-run (real? coroutine? . -> . boolean?))
(coroutine-run ((or/c evt? real?) coroutine? . -> . boolean?))
(coroutine-result (coroutine? . -> . any))
(coroutine-kill (coroutine? . -> . any))))

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

@ -56,18 +56,19 @@
;; coroutines ----------------------------------------
(define MAX-RUN-TIME 100) ; in msecs
(define cntr 0)
(define cntr-sema (make-semaphore))
(define w (coroutine (lambda (enable-stop)
(let loop ((i 0))
(enable-stop #f)
(set! cntr i)
(when (= cntr 1)
(semaphore-post cntr-sema))
(enable-stop #t)
(loop (add1 i))))))
(test #t coroutine? 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 (void) coroutine-kill w)
(test #t coroutine-run 100 w)
@ -81,13 +82,13 @@
(set! cntr i)
(enable-stop #t)
(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 #t coroutine-run 100 w2)
(define w3 (coroutine (lambda (enable-stop)
(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 #t coroutine-run 100 w3)
@ -95,7 +96,7 @@
(enable-stop #f)
(raise 15))))
(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)
(report-errs)

2
collects/tests/r6rs/base.ss
View File

@ -1005,7 +1005,7 @@
'ok)
(test p.car 4)
; (test/exn (set! p.car 15) &syntax)
; (test/exn (set! p.car 15) &syntax) - not a runtime test
(test/unspec (set! p2.car 15))
(test p2.car 15)

4
collects/tests/r6rs/test.ss
View File

@ -108,7 +108,7 @@
(display " tests passed\n"))
(begin
(display (length failures))
(display " tests failed:\n")
(display " tests failed:\n\n")
(for-each (lambda (t)
(display "Expression:\n ")
(write (car t))
@ -116,7 +116,7 @@
(write (cadr t))
(display "\nExpected:\n ")
(write (caddr t))
(newline))
(display "\n\n"))
(reverse failures))
(display (length failures))
(display " of ")