]> gitweb.factorcode.org Git - factor.git/blob - basis/models/product/product-tests.factor
c26866e83b41630c9311ca14921e9bb368520bc7
[factor.git] / basis / models / product / product-tests.factor
1 USING: arrays generic kernel math models namespaces sequences assocs\r
2 tools.test models.product accessors locals ;\r
3 IN: models.product.tests\r
4 \r
5 [ ] [\r
6     1 <model> "a" set\r
7     2 <model> "b" set\r
8     "a" get "b" get 2array <product> "c" set\r
9 ] unit-test\r
10 \r
11 [ ] [ "c" get activate-model ] unit-test\r
12 \r
13 [ { 1 2 } ] [ "c" get value>> ] unit-test\r
14 \r
15 [ ] [ 3 "b" get set-model ] unit-test\r
16 \r
17 [ { 1 3 } ] [ "c" get value>> ] unit-test\r
18 \r
19 [ ] [ { 4 5 } "c" get set-model ] unit-test\r
20 \r
21 [ { 4 5 } ] [ "c" get value>> ] unit-test\r
22 \r
23 [ ] [ "c" get deactivate-model ] unit-test\r
24 \r
25 TUPLE: an-observer { i integer } ;\r
26 \r
27 M: an-observer model-changed nip [ 1 + ] change-i drop ;\r
28 \r
29 [ 1 0 ] [\r
30     [let\r
31         1 <model> :> m1\r
32         2 <model> :> m2\r
33         { m1 m2 } <product> :> c\r
34         an-observer new :> o1\r
35         an-observer new :> o2\r
36         \r
37         o1 m1 add-connection\r
38         o2 m2 add-connection\r
39 \r
40         c activate-model\r
41     \r
42         "OH HAI" m1 set-model\r
43         o1 i>>\r
44         o2 i>>\r
45     ]\r
46 ] unit-test\r