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