Fix mailbox-get-all, and make mailbox timeouts throw a wait-timeout error instead of a string

db4
Slava Pestov 2009-04-04 23:04:53 -05:00
parent 52060e6253
commit 1023fa51f4
3 changed files with 18 additions and 4 deletions

View File

@ -20,10 +20,12 @@ IN: concurrency.conditions
]
] dip later ;
ERROR: wait-timeout ;
: wait ( queue timeout status -- )
over [
[ queue-timeout [ drop ] ] dip suspend
[ "Timeout" throw ] [ cancel-alarm ] if
[ wait-timeout ] [ cancel-alarm ] if
] [
[ drop '[ _ push-front ] ] dip suspend drop
] if ;

View File

@ -1,6 +1,6 @@
IN: concurrency.mailboxes.tests
USING: concurrency.mailboxes concurrency.count-downs vectors
sequences threads tools.test math kernel strings namespaces
USING: concurrency.mailboxes concurrency.count-downs concurrency.conditions
vectors sequences threads tools.test math kernel strings namespaces
continuations calendar destructors ;
{ 1 1 } [ [ integer? ] mailbox-get? ] must-infer-as
@ -75,3 +75,15 @@ continuations calendar destructors ;
[ ] [ "d" get 5 seconds await-timeout ] unit-test
[ ] [ "m" get dispose ] unit-test
[ { "foo" "bar" } ] [
<mailbox>
"foo" over mailbox-put
"bar" over mailbox-put
mailbox-get-all
] unit-test
[
<mailbox> 1 seconds mailbox-get-timeout
] [ wait-timeout? ] must-fail-with

View File

@ -49,7 +49,7 @@ M: mailbox dispose* threads>> notify-all ;
: mailbox-get-all-timeout ( mailbox timeout -- array )
block-if-empty
[ dup mailbox-empty? ]
[ dup mailbox-empty? not ]
[ dup data>> pop-back ]
produce nip ;