steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

concurrency.mailboxes: mailboxes should not be disposable, since futures and promises use them in a transient fashion, causing leaks

db4
Slava Pestov 2010-02-19 21:45:43 +13:00
parent 48fe9029af
commit 7692bd1715
2 changed files with 9 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
basis/concurrency/mailboxes/mailboxes-tests.factor
View File

@ -42,40 +42,6 @@ IN: concurrency.mailboxes.tests
mailbox-get mailbox-get
] unit-test ] unit-test
<mailbox> "m" set
1 <count-down> "c" set
1 <count-down> "d" set
[
"c" get await
[ "m" get mailbox-get drop ]
[ drop "d" get count-down ] recover
] "Mailbox close test" spawn drop
[ ] [ "c" get count-down ] unit-test
[ ] [ "m" get dispose ] unit-test
[ ] [ "d" get 5 seconds await-timeout ] unit-test
[ ] [ "m" get dispose ] unit-test
<mailbox> "m" set
1 <count-down> "c" set
1 <count-down> "d" set
[
"c" get await
"m" get wait-for-close
"d" get count-down
] "Mailbox close test" spawn drop
[ ] [ "c" get count-down ] unit-test
[ ] [ "m" get dispose ] unit-test
[ ] [ "d" get 5 seconds await-timeout ] unit-test
[ ] [ "m" get dispose ] unit-test
[ { "foo" "bar" } ] [ [ { "foo" "bar" } ] [
<mailbox> <mailbox>
"foo" over mailbox-put "foo" over mailbox-put
@ -86,4 +52,3 @@ IN: concurrency.mailboxes.tests
[ [
<mailbox> 1 seconds mailbox-get-timeout <mailbox> 1 seconds mailbox-get-timeout
] [ wait-timeout? ] must-fail-with ] [ wait-timeout? ] must-fail-with

20
basis/concurrency/mailboxes/mailboxes.factor
View File

@ -1,17 +1,17 @@
! Copyright (C) 2005, 2008 Chris Double, Slava Pestov. ! Copyright (C) 2005, 2010 Chris Double, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: dlists deques threads sequences continuations USING: dlists deques threads sequences continuations namespaces
destructors namespaces math quotations words kernel math quotations words kernel arrays assocs init system
arrays assocs init system concurrency.conditions accessors concurrency.conditions accessors debugger debugger.threads
debugger debugger.threads locals fry ; locals fry ;
IN: concurrency.mailboxes IN: concurrency.mailboxes
TUPLE: mailbox < disposable threads data ; TUPLE: mailbox threads data ;
M: mailbox dispose* threads>> notify-all ;
: <mailbox> ( -- mailbox ) : <mailbox> ( -- mailbox )
mailbox new-disposable <dlist> >>threads <dlist> >>data ; mailbox new
<dlist> >>threads
<dlist> >>data ;
: mailbox-empty? ( mailbox -- bool ) : mailbox-empty? ( mailbox -- bool )
data>> deque-empty? ; data>> deque-empty? ;
@ -24,14 +24,12 @@ M: mailbox dispose* threads>> notify-all ;
[ threads>> ] dip "mailbox" wait ; [ threads>> ] dip "mailbox" wait ;
:: block-unless-pred ( mailbox timeout pred: ( message -- ? ) -- ) :: block-unless-pred ( mailbox timeout pred: ( message -- ? ) -- )
mailbox check-disposed
mailbox data>> pred dlist-any? [ mailbox data>> pred dlist-any? [
mailbox timeout wait-for-mailbox mailbox timeout wait-for-mailbox
mailbox timeout pred block-unless-pred mailbox timeout pred block-unless-pred
] unless ; inline recursive ] unless ; inline recursive
: block-if-empty ( mailbox timeout -- mailbox ) : block-if-empty ( mailbox timeout -- mailbox )
over check-disposed
over mailbox-empty? [ over mailbox-empty? [
2dup wait-for-mailbox block-if-empty 2dup wait-for-mailbox block-if-empty
] [ ] [