From 2834b00b7e60d5ef259cfff3c5104034bb1632f6 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 18 Mar 2008 02:16:06 +0000
Subject: [PATCH] refine failure handling of thread-send

svn: r9012
---
 collects/scribblings/reference/threads.scrbl | 12 +++++++++---
 collects/tests/mzscheme/sync.ss              |  6 ++++++
 src/mzscheme/src/sema.c                      |  4 ++--
 3 files changed, 17 insertions(+), 5 deletions(-)

diff --git a/collects/scribblings/reference/threads.scrbl b/collects/scribblings/reference/threads.scrbl
index 76773b5e78..b0265a5cd1 100644
--- a/collects/scribblings/reference/threads.scrbl
+++ b/collects/scribblings/reference/threads.scrbl
@@ -232,10 +232,16 @@ asynchronous channel.
 
 @margin-note/ref{See also @secref["async-channel"].}
 
-@defproc[(thread-send [thd thread?] [v any/c]) void?]{
+@defproc[(thread-send [thd thread?] [v any/c] 
+                      [fail-thunk (-> any) 
+                                  (lambda () (raise-mismatch-error ....))]) 
+         any]{
 
-Queues @scheme[v] as a message to @scheme[thd]. This function never
-blocks.}
+Queues @scheme[v] as a message to @scheme[thd] without blocking. If
+the message is queued, the result is @|void-const|. If @scheme[thd] is
+stops running---as in @scheme[thread-running?]---before the message is
+queued, then @scheme[fail-thunk] is called (through a tail call) to
+produce the result.}
 
 @defproc[(thread-receive) any/c]{
 
diff --git a/collects/tests/mzscheme/sync.ss b/collects/tests/mzscheme/sync.ss
index ba54cfc3c4..ce37470a7e 100644
--- a/collects/tests/mzscheme/sync.ss
+++ b/collects/tests/mzscheme/sync.ss
@@ -724,6 +724,12 @@
   (thread-send t 2)
   (sync (system-idle-evt))
   (test '(0 1 2) values s))
+(let ([t (thread void)])
+  (sync (system-idle-evt))
+  (test 'z thread-send t 'x (lambda () 'z))
+  (test-values '(a z) (lambda ()
+                        (thread-send t 'x (lambda () (values 'a 'z)))))
+  (err/rt-test (thread-send t 'x)))
 
 ;; ----------------------------------------
 ;;  Garbage collection
diff --git a/src/mzscheme/src/sema.c b/src/mzscheme/src/sema.c
index d70b85b4e4..4b76a2c16c 100644
--- a/src/mzscheme/src/sema.c
+++ b/src/mzscheme/src/sema.c
@@ -146,7 +146,7 @@ void scheme_init_sema(Scheme_Env *env)
   scheme_add_global_constant("thread-send", 
 			     scheme_make_prim_w_arity(thread_send,
 						      "thread-send", 
-						      2, 2), 
+						      2, 3), 
 			     env);
   scheme_add_global_constant("thread-receive", 
 			     scheme_make_prim_w_arity(thread_receive,
@@ -1076,7 +1076,7 @@ static Scheme_Object *thread_send(int argc, Scheme_Object **argv)
       if (argc > 2) {
         return _scheme_tail_apply(argv[2], 0, NULL);
       } else
-        scheme_raise_exn(MZEXN_FAIL, "thread-send: thread is not running");
+        scheme_raise_exn(MZEXN_FAIL_CONTRACT, "thread-send: target thread is not running");
     }
   } else 
     scheme_wrong_type("thread-send", "thread", 0, argc, argv);