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

new accessors

db4
Doug Coleman 2008-09-02 01:53:43 -05:00
parent ce72a5de8e
commit 33569bae19
5 changed files with 37 additions and 38 deletions

10
basis/models/compose/compose-tests.factor
View File

@ -1,6 +1,6 @@
IN: models.compose.tests
USING: arrays generic kernel math models namespaces sequences assocs
tools.test models.compose ;
tools.test models.compose accessors ;
IN: models.compose.tests
! Test compose
[ ] [
@ -11,14 +11,14 @@ tools.test models.compose ;
[ ] [ "c" get activate-model ] unit-test
[ { 1 2 } ] [ "c" get model-value ] unit-test
[ { 1 2 } ] [ "c" get value>> ] unit-test
[ ] [ 3 "b" get set-model ] unit-test
[ { 1 3 } ] [ "c" get model-value ] unit-test
[ { 1 3 } ] [ "c" get value>> ] unit-test
[ ] [ { 4 5 } "c" get set-model ] unit-test
[ { 4 5 } ] [ "c" get model-value ] unit-test
[ { 4 5 } ] [ "c" get value>> ] unit-test
[ ] [ "c" get deactivate-model ] unit-test

14
basis/models/filter/filter-tests.factor
View File

@ -1,18 +1,18 @@
IN: models.filter.tests
USING: arrays generic kernel math models namespaces sequences assocs
tools.test models.filter ;
tools.test models.filter accessors ;
IN: models.filter.tests
! Test multiple filters
3 <model> "x" set
"x" get [ 2 * ] <filter> dup "z" set
[ 1+ ] <filter> "y" set
[ ] [ "y" get activate-model ] unit-test
[ t ] [ "z" get "x" get model-connections memq? ] unit-test
[ 7 ] [ "y" get model-value ] unit-test
[ t ] [ "z" get "x" get connections>> memq? ] unit-test
[ 7 ] [ "y" get value>> ] unit-test
[ ] [ 4 "x" get set-model ] unit-test
[ 9 ] [ "y" get model-value ] unit-test
[ 9 ] [ "y" get value>> ] unit-test
[ ] [ "y" get deactivate-model ] unit-test
[ f ] [ "z" get "x" get model-connections memq? ] unit-test
[ f ] [ "z" get "x" get connections>> memq? ] unit-test
3 <model> "x" set
"x" get [ sq ] <filter> "y" set
@ -20,5 +20,5 @@ tools.test models.filter ;
4 "x" get set-model
"y" get activate-model
[ 16 ] [ "y" get model-value ] unit-test
[ 16 ] [ "y" get value>> ] unit-test
"y" get deactivate-model

28
basis/models/history/history-tests.factor
View File

@ -1,37 +1,37 @@
IN: models.history.tests
USING: arrays generic kernel math models namespaces sequences assocs
tools.test models.history ;
tools.test models.history accessors ;
IN: models.history.tests
f <history> "history" set
"history" get add-history
[ t ] [ "history" get history-back empty? ] unit-test
[ t ] [ "history" get history-forward empty? ] unit-test
[ t ] [ "history" get back>> empty? ] unit-test
[ t ] [ "history" get forward>> empty? ] unit-test
"history" get add-history
3 "history" get set-model
[ t ] [ "history" get history-back empty? ] unit-test
[ t ] [ "history" get history-forward empty? ] unit-test
[ t ] [ "history" get back>> empty? ] unit-test
[ t ] [ "history" get forward>> empty? ] unit-test
"history" get add-history
4 "history" get set-model
[ f ] [ "history" get history-back empty? ] unit-test
[ t ] [ "history" get history-forward empty? ] unit-test
[ f ] [ "history" get back>> empty? ] unit-test
[ t ] [ "history" get forward>> empty? ] unit-test
"history" get go-back
[ 3 ] [ "history" get model-value ] unit-test
[ 3 ] [ "history" get value>> ] unit-test
[ t ] [ "history" get history-back empty? ] unit-test
[ f ] [ "history" get history-forward empty? ] unit-test
[ t ] [ "history" get back>> empty? ] unit-test
[ f ] [ "history" get forward>> empty? ] unit-test
"history" get go-forward
[ 4 ] [ "history" get model-value ] unit-test
[ 4 ] [ "history" get value>> ] unit-test
[ f ] [ "history" get history-back empty? ] unit-test
[ t ] [ "history" get history-forward empty? ] unit-test
[ f ] [ "history" get back>> empty? ] unit-test
[ t ] [ "history" get forward>> empty? ] unit-test

12
basis/models/mapping/mapping-tests.factor
View File

@ -1,6 +1,6 @@
IN: models.mapping.tests
USING: arrays generic kernel math models namespaces sequences assocs
tools.test models.mapping ;
tools.test models.mapping accessors ;
IN: models.mapping.tests
! Test mapping
[ ] [
@ -14,7 +14,7 @@ tools.test models.mapping ;
[ ] [ "m" get activate-model ] unit-test
[ H{ { "one" 1 } { "two" 2 } } ] [
"m" get model-value
"m" get value>>
] unit-test
[ ] [
@ -23,12 +23,12 @@ tools.test models.mapping ;
] unit-test
[ H{ { "one" 3 } { "two" 4 } } ] [
"m" get model-value
"m" get value>>
] unit-test
[ H{ { "one" 5 } { "two" 4 } } ] [
5 "one" "m" get mapping-assoc at set-model
"m" get model-value
5 "one" "m" get assoc>> at set-model
"m" get value>>
] unit-test
[ ] [ "m" get deactivate-model ] unit-test

11
basis/models/models-tests.factor
View File

@ -1,13 +1,12 @@
IN: models.tests
USING: arrays generic kernel math models models.compose
namespaces sequences assocs
tools.test ;
namespaces sequences assocs accessors tools.test ;
IN: models.tests
TUPLE: model-tester hit? ;
: <model-tester> model-tester new ;
M: model-tester model-changed nip t swap set-model-tester-hit? ;
M: model-tester model-changed nip t >>hit? drop ;
[ T{ model-tester f t } ]
[
@ -20,7 +19,7 @@ M: model-tester model-changed nip t swap set-model-tester-hit? ;
"model-a" get "model-b" get 2array <compose> "model-c" set
"model-c" get activate-model
[ { 3 4 } ] [ "model-c" get model-value ] unit-test
[ { 3 4 } ] [ "model-c" get value>> ] unit-test
"model-c" get deactivate-model
T{ model-tester f f } "tester" set
@ -30,5 +29,5 @@ T{ model-tester f f } "tester" set
"tester" get "model-c" get add-connection
6 "model-a" get set-model
"tester" get
"model-c" get model-value
"model-c" get value>>
] unit-test