added send-synchronous-timeout word and tests

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

basis/concurrency/messaging/messaging.factor

@@ -61,6 +61,15 @@ M: cannot-send-synchronous-to-self summary
         data>>
     ] if ;
 
+: send-synchronous-timeout ( timeout message thread -- reply ) 
+    dup self eq? [
+        cannot-send-synchronous-to-self
+    ] [
+        [ <synchronous> dup ] dip send
+        '[ _ synchronous-reply? ] receive-if-timeout
+        data>>
+    ] if ;   
+    
 : reply-synchronous ( message synchronous -- )
     [ <reply> ] keep sender>> send ;