diff --git a/basis/concurrency/conditions/conditions.factor b/basis/concurrency/conditions/conditions.factor index 11e624110c..ad00bbdfa9 100644 --- a/basis/concurrency/conditions/conditions.factor +++ b/basis/concurrency/conditions/conditions.factor @@ -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 ; diff --git a/basis/concurrency/mailboxes/mailboxes-tests.factor b/basis/concurrency/mailboxes/mailboxes-tests.factor index 64971eeb77..81e54f1807 100644 --- a/basis/concurrency/mailboxes/mailboxes-tests.factor +++ b/basis/concurrency/mailboxes/mailboxes-tests.factor @@ -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" } ] [ + + "foo" over mailbox-put + "bar" over mailbox-put + mailbox-get-all +] unit-test + +[ + 1 seconds mailbox-get-timeout +] [ wait-timeout? ] must-fail-with + \ No newline at end of file diff --git a/basis/concurrency/mailboxes/mailboxes.factor b/basis/concurrency/mailboxes/mailboxes.factor index f6aec94b41..200adb14ae 100755 --- a/basis/concurrency/mailboxes/mailboxes.factor +++ b/basis/concurrency/mailboxes/mailboxes.factor @@ -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 ;