added send-synchronous-timeout word and tests

diff --git a/basis/concurrency/messaging/messaging-tests.factor b/basis/concurrency/messaging/messaging-tests.factor
index dd94ad15b32dfae78ae7857f661743e13fd4b006..7cbe2b21ffb82de08982c70c81ab23a39849e1db 100644 (file)
--- a/basis/concurrency/messaging/messaging-tests.factor
+++ b/basis/concurrency/messaging/messaging-tests.factor
@@ -3,7 +3,7 @@
 USING: kernel threads vectors arrays sequences namespaces make
 tools.test continuations deques strings math words match
 quotations concurrency.messaging concurrency.mailboxes
-concurrency.count-downs accessors ;
+concurrency.count-downs concurrency.conditions accessors calendar ;
 IN: concurrency.messaging.tests
 
 [ ] [ my-mailbox data>> clear-deque ] unit-test
@@ -15,6 +15,19 @@ IN: concurrency.messaging.tests
     "sent" swap send-synchronous
 ] unit-test
 
+[ "received" ] [ 
+    [
+        receive "received" swap reply-synchronous
+    ] "Synchronous test" spawn
+    [ 100 milliseconds "sent" ] dip send-synchronous-timeout
+] unit-test
+
+[ [ 100 milliseconds sleep
+    receive "received" swap reply-synchronous ] "Synchronous test" spawn
+  [ 50 milliseconds "sent" ] dip send-synchronous-timeout
+] [ wait-timeout? ] must-fail-with
+
+
 [ 1 3 2 ] [
     1 self send
     2 self send

diff --git a/basis/concurrency/messaging/messaging.factor b/basis/concurrency/messaging/messaging.factor
index ce7f7d611083f8333469f4649d02c825f59a9f5a..8438f7effe6ac75bd83591be7db8d37f4b9d2476 100644 (file)
--- a/basis/concurrency/messaging/messaging.factor
+++ b/basis/concurrency/messaging/messaging.factor
@@ -61,6 +61,15 @@ M: cannot-send-synchronous-to-self summary
         data>>\r
     ] if ;\r
 \r
+: send-synchronous-timeout ( timeout message thread -- reply ) \r
+    dup self eq? [\r
+        cannot-send-synchronous-to-self\r
+    ] [\r
+        [ <synchronous> dup ] dip send\r
+        '[ _ synchronous-reply? ] receive-if-timeout\r
+        data>>\r
+    ] if ;   \r
+    \r
 : reply-synchronous ( message synchronous -- )\r
     [ <reply> ] keep sender>> send ;\r
 \r