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* | m1 [ 1 <model> ]\r
  31             m2 [ 2 <model> ]\r
  32             c [ { m1 m2 } <product> ]\r
  33             o1 [ an-observer new ]\r
  34             o2 [ an-observer new ] |\r
  35         \r
  36         o1 m1 add-connection\r
  37         o2 m2 add-connection\r
  38 \r
  39         c activate-model\r
  40     \r
  41         "OH HAI" m1 set-model\r
  42         o1 i>>\r
  43         o2 i>>\r
  44     ]\r
  45 ] unit-test\r