From 1023fa51f4427c6a89b45fbeb87863939b9da703 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 4 Apr 2009 23:04:53 -0500
Subject: [PATCH] Fix mailbox-get-all, and make mailbox timeouts throw a
wait-timeout error instead of a string
---
basis/concurrency/conditions/conditions.factor | 4 +++-
.../concurrency/mailboxes/mailboxes-tests.factor | 16 ++++++++++++++--
basis/concurrency/mailboxes/mailboxes.factor | 2 +-
3 files changed, 18 insertions(+), 4 deletions(-)
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" } ] [
+ <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
+
\ 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 ;