Fix unit tests
parent
08715844d4
commit
46c76b8b1b
|
@ -2,7 +2,7 @@ USING: help.markup help.syntax kernel ;
|
|||
IN: boxes
|
||||
|
||||
HELP: box
|
||||
{ $class-description "A data type holding a single value in the " { $link box-value } " slot. The " { $link box-full? } " slot indicates if the value is set." } ;
|
||||
{ $class-description "A data type holding a single value in the " { $snippet "value" } " slot. The " { $snippet "occupied" } " slot indicates if the value is set." } ;
|
||||
|
||||
HELP: <box>
|
||||
{ $values { "box" box } }
|
||||
|
@ -27,12 +27,11 @@ ARTICLE: "boxes" "Boxes"
|
|||
{ $subsection box }
|
||||
"Creating an empty box:"
|
||||
{ $subsection <box> }
|
||||
"Testing if a box is full:"
|
||||
{ $subsection box-full? }
|
||||
"Storing a value and removing a value from a box:"
|
||||
{ $subsection >box }
|
||||
{ $subsection box> }
|
||||
"Safely removing a value:"
|
||||
{ $subsection ?box } ;
|
||||
{ $subsection ?box }
|
||||
"Testing if a box is full can be done by reading the " { $snippet "occupied" } " slot." ;
|
||||
|
||||
ABOUT: "boxes"
|
||||
|
|
|
@ -1,17 +1,17 @@
|
|||
IN: boxes.tests
|
||||
USING: boxes namespaces tools.test ;
|
||||
USING: boxes namespaces tools.test accessors ;
|
||||
|
||||
[ ] [ <box> "b" set ] unit-test
|
||||
|
||||
[ ] [ 3 "b" get >box ] unit-test
|
||||
|
||||
[ t ] [ "b" get box-full? ] unit-test
|
||||
[ t ] [ "b" get occupied>> ] unit-test
|
||||
|
||||
[ 4 "b" >box ] must-fail
|
||||
|
||||
[ 3 ] [ "b" get box> ] unit-test
|
||||
|
||||
[ f ] [ "b" get box-full? ] unit-test
|
||||
[ f ] [ "b" get occupied>> ] unit-test
|
||||
|
||||
[ "b" get box> ] must-fail
|
||||
|
||||
|
@ -21,4 +21,4 @@ USING: boxes namespaces tools.test ;
|
|||
|
||||
[ 12 t ] [ "b" get ?box ] unit-test
|
||||
|
||||
[ f ] [ "b" get box-full? ] unit-test
|
||||
[ f ] [ "b" get occupied>> ] unit-test
|
||||
|
|
|
@ -3,24 +3,24 @@
|
|||
USING: kernel accessors ;
|
||||
IN: boxes
|
||||
|
||||
TUPLE: box value full? ;
|
||||
TUPLE: box value occupied ;
|
||||
|
||||
: <box> ( -- box ) box new ;
|
||||
|
||||
ERROR: box-full box ;
|
||||
|
||||
: >box ( value box -- )
|
||||
dup full?>>
|
||||
[ box-full ] [ t >>full? (>>value) ] if ;
|
||||
dup occupied>>
|
||||
[ box-full ] [ t >>occupied (>>value) ] if ;
|
||||
|
||||
ERROR: box-empty box ;
|
||||
|
||||
: box> ( box -- value )
|
||||
dup full?>>
|
||||
[ [ f ] change-value f >>full? drop ] [ box-empty ] if ;
|
||||
dup occupied>>
|
||||
[ [ f ] change-value f >>occupied drop ] [ box-empty ] if ;
|
||||
|
||||
: ?box ( box -- value/f ? )
|
||||
dup full?>> [ box> t ] [ drop f f ] if ;
|
||||
dup occupied>> [ box> t ] [ drop f f ] if ;
|
||||
|
||||
: if-box? ( box quot -- )
|
||||
>r ?box r> [ drop ] if ; inline
|
||||
|
|
|
@ -101,23 +101,6 @@ SYMBOL: error-counter
|
|||
[ 1 ] [ error-counter get ] unit-test
|
||||
] with-scope
|
||||
|
||||
TUPLE: dispose-error ;
|
||||
|
||||
M: dispose-error dispose 3 throw ;
|
||||
|
||||
TUPLE: dispose-dummy disposed? ;
|
||||
|
||||
M: dispose-dummy dispose t >>disposed? drop ;
|
||||
|
||||
T{ dispose-error } "a" set
|
||||
T{ dispose-dummy } "b" set
|
||||
|
||||
[ f ] [ "b" get disposed?>> ] unit-test
|
||||
|
||||
[ { "a" "b" } [ get ] map dispose-each ] [ 3 = ] must-fail-with
|
||||
|
||||
[ t ] [ "b" get disposed?>> ] unit-test
|
||||
|
||||
[ ] [ [ return ] with-return ] unit-test
|
||||
|
||||
[ { } [ ] attempt-all ] [ attempt-all-error? ] must-fail-with
|
||||
|
|
|
@ -1,6 +1,23 @@
|
|||
USING: destructors kernel tools.test continuations ;
|
||||
IN: destructors.tests
|
||||
|
||||
TUPLE: dispose-error ;
|
||||
|
||||
M: dispose-error dispose 3 throw ;
|
||||
|
||||
TUPLE: dispose-dummy disposed? ;
|
||||
|
||||
M: dispose-dummy dispose t >>disposed? drop ;
|
||||
|
||||
T{ dispose-error } "a" set
|
||||
T{ dispose-dummy } "b" set
|
||||
|
||||
[ f ] [ "b" get disposed?>> ] unit-test
|
||||
|
||||
[ { "a" "b" } [ get ] map dispose-each ] [ 3 = ] must-fail-with
|
||||
|
||||
[ t ] [ "b" get disposed?>> ] unit-test
|
||||
|
||||
TUPLE: dummy-obj destroyed? ;
|
||||
|
||||
: <dummy-obj> dummy-obj new ;
|
||||
|
|
|
@ -5,7 +5,7 @@ sequences strings vectors words quotations effects tools.test
|
|||
continuations generic.standard sorting assocs definitions
|
||||
prettyprint io inspector classes.tuple classes.union
|
||||
classes.predicate debugger threads.private io.streams.string
|
||||
io.timeouts io.thread sequences.private ;
|
||||
io.timeouts io.thread sequences.private destructors ;
|
||||
IN: inference.tests
|
||||
|
||||
[ ] [ [ 1 ] dataflow [ ] transform-nodes drop ] unit-test
|
||||
|
|
|
@ -13,8 +13,7 @@ concurrency.messaging continuations ;
|
|||
|
||||
[ ] [ test-node dup 1array swap (start-node) ] unit-test
|
||||
|
||||
[ ] [ yield ] unit-test
|
||||
[ ] [ yield ] unit-test
|
||||
[ ] [ 100 sleep ] unit-test
|
||||
|
||||
[ ] [
|
||||
[
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel threads boxes ;
|
||||
USING: kernel threads boxes accessors ;
|
||||
IN: concurrency.exchangers
|
||||
|
||||
! Motivated by
|
||||
|
@ -12,10 +12,10 @@ TUPLE: exchanger thread object ;
|
|||
<box> <box> exchanger boa ;
|
||||
|
||||
: exchange ( obj exchanger -- newobj )
|
||||
dup exchanger-thread box-full? [
|
||||
dup exchanger-object box>
|
||||
>r exchanger-thread box> resume-with r>
|
||||
dup thread>> occupied>> [
|
||||
dup object>> box>
|
||||
>r thread>> box> resume-with r>
|
||||
] [
|
||||
[ exchanger-object >box ] keep
|
||||
[ exchanger-thread >box ] curry "exchange" suspend
|
||||
[ object>> >box ] keep
|
||||
[ thread>> >box ] curry "exchange" suspend
|
||||
] if ;
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
IN: concurrency.mailboxes.tests
|
||||
USING: concurrency.mailboxes concurrency.count-downs vectors
|
||||
sequences threads tools.test math kernel strings namespaces
|
||||
continuations calendar ;
|
||||
continuations calendar destructors ;
|
||||
|
||||
[ V{ 1 2 3 } ] [
|
||||
0 <vector>
|
||||
|
|
|
@ -71,7 +71,7 @@ M: mailbox dispose* threads>> notify-all ;
|
|||
f swap mailbox-get-timeout? ; inline
|
||||
|
||||
: wait-for-close-timeout ( mailbox timeout -- )
|
||||
over closed>>
|
||||
over disposed>>
|
||||
[ 2drop ] [ 2dup wait-for-mailbox wait-for-close-timeout ] if ;
|
||||
|
||||
: wait-for-close ( mailbox -- )
|
||||
|
|
|
@ -1,7 +1,6 @@
|
|||
USING: accessors math kernel namespaces continuations
|
||||
io.files io.monitors io.monitors.recursive io.backend
|
||||
concurrency.mailboxes
|
||||
tools.test ;
|
||||
concurrency.mailboxes tools.test destructors ;
|
||||
IN: io.monitors.recursive.tests
|
||||
|
||||
\ pump-thread must-infer
|
||||
|
|
Loading…
Reference in New Issue