From cfa7c3771cca1c9305c8e11598c4acd1b4fd9273 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@oberon.internal.stack-effects.com>
Date: Wed, 27 Feb 2008 19:24:24 -0600
Subject: [PATCH] Fixes for linked error change

---
 .../combinators/combinators-tests.factor      |  2 +-
 extra/concurrency/locks/locks-tests.factor    |  2 +-
 extra/concurrency/mailboxes/mailboxes.factor  | 21 ++++++++++++++-----
 .../messaging/messaging-tests.factor          |  2 +-
 4 files changed, 19 insertions(+), 8 deletions(-)

diff --git a/extra/concurrency/combinators/combinators-tests.factor b/extra/concurrency/combinators/combinators-tests.factor
index 831dad6b56..e06b97489b 100755
--- a/extra/concurrency/combinators/combinators-tests.factor
+++ b/extra/concurrency/combinators/combinators-tests.factor
@@ -11,7 +11,7 @@ concurrency.mailboxes threads sequences ;
 [ { 1 4 9 } ] [ { 1 2 3 } [ 1000 random sleep sq ] parallel-map ] unit-test
 
 [ { 1 2 3 } [ dup 2 mod 0 = [ "Even" throw ] when ] parallel-map ]
-[ linked-error "Even" = ] must-fail-with
+[ delegate "Even" = ] must-fail-with
 
 [ V{ 0 3 6 9 } ]
 [ 10 [ 3 mod zero? ] parallel-subset ] unit-test
diff --git a/extra/concurrency/locks/locks-tests.factor b/extra/concurrency/locks/locks-tests.factor
index 1280339231..92f1a9f103 100755
--- a/extra/concurrency/locks/locks-tests.factor
+++ b/extra/concurrency/locks/locks-tests.factor
@@ -174,5 +174,5 @@ threads sequences calendar ;
     ] ;
 
 [ lock-timeout-test ] [
-    linked-thread thread-name "Lock timeout-er" =
+    linked-error-thread thread-name "Lock timeout-er" =
 ] must-fail-with
diff --git a/extra/concurrency/mailboxes/mailboxes.factor b/extra/concurrency/mailboxes/mailboxes.factor
index adfb5bac0a..28b2fb7221 100755
--- a/extra/concurrency/mailboxes/mailboxes.factor
+++ b/extra/concurrency/mailboxes/mailboxes.factor
@@ -65,12 +65,23 @@ TUPLE: mailbox threads data ;
 : mailbox-get? ( pred mailbox -- obj )
     f mailbox-get-timeout? ; inline
 
-TUPLE: linked error thread ;
+TUPLE: linked-error thread ;
 
-C: <linked> linked
+: <linked-error> ( error thread -- linked )
+    { set-delegate set-linked-error-thread }
+    linked-error construct ;
 
-: ?linked dup linked? [ rethrow ] when ;
+: ?linked dup linked-error? [ rethrow ] when ;
+
+TUPLE: linked-thread supervisor ;
+
+M: linked-thread error-in-thread
+    [ <linked-error> ] keep
+    linked-thread-supervisor mailbox-put ;
+
+: <linked-thread> ( quot name mailbox -- thread' )
+    >r <thread> linked-thread construct-delegate r>
+    over set-linked-thread-supervisor ;
 
 : spawn-linked-to ( quot name mailbox -- thread )
-    [ >r <linked> r> mailbox-put ] curry <thread>
-    [ (spawn) ] keep ;
+    <linked-thread> [ (spawn) ] keep ;
diff --git a/extra/concurrency/messaging/messaging-tests.factor b/extra/concurrency/messaging/messaging-tests.factor
index 5f241b77e3..3f6e4e3ed8 100755
--- a/extra/concurrency/messaging/messaging-tests.factor
+++ b/extra/concurrency/messaging/messaging-tests.factor
@@ -29,7 +29,7 @@ IN: temporary
         "crash" throw
     ] "Linked test" spawn-linked drop
     receive
-] [ linked-error "crash" = ] must-fail-with
+] [ delegate "crash" = ] must-fail-with
 
 MATCH-VARS: ?from ?to ?value ;
 SYMBOL: increment