basis/models/models-tests.factor

   1 USING: accessors arrays assocs generic kernel math models models.arrow
   2 models.product namespaces sequences tools.test ;
   3 IN: models.tests
   4
   5 TUPLE: model-tester hit? ;
   6
   7 : <model-tester> ( -- model-tester ) model-tester new ;
   8
   9 M: model-tester model-changed nip t >>hit? drop ;
  10
  11 { T{ model-tester f t } }
  12 [
  13     T{ model-tester f f } clone 3 <model> 2dup add-connection
  14     5 swap set-model
  15 ] unit-test
  16
  17 3 <model> "model-a" set
  18 4 <model> "model-b" set
  19 "model-a" get "model-b" get 2array <product> "model-c" set
  20
  21 "model-c" get activate-model
  22 { { 3 4 } } [ "model-c" get value>>  ] unit-test
  23 "model-c" get deactivate-model
  24
  25 T{ model-tester f f } "tester" set
  26
  27 { T{ model-tester f t } { 6 4 } }
  28 [
  29     "tester" get "model-c" get add-connection
  30     6 "model-a" get set-model
  31     "tester" get
  32     "model-c" get value>>
  33 ] unit-test
  34
  35 { T{ model-tester f t } V{ 5 } }
  36 [
  37     T{ model-tester f f } clone V{ } clone <model> 2dup add-connection
  38     5 swap [ push-model ] [ value>> ] bi
  39 ] unit-test
  40
  41 { T{ model-tester f t } 5 V{ }  }
  42 [
  43     T{ model-tester f f } clone V{ 5 } clone <model> 2dup add-connection
  44     [ pop-model ] [ value>> ] bi
  45 ] unit-test
  46
  47 { f } [ 46 <model> [ 1 + ] <arrow> value>> ] unit-test
  48 { 47 } [ 46 <model> [ 1 + ] <arrow> compute-model ] unit-test
  49 { 0 } [ 46 <model> [ 1 + ] <arrow> [ compute-model drop ] keep ref>> ] unit-test