basis/mirrors/mirrors-tests.factor

   1 USING: mirrors tools.test assocs kernel arrays accessors words
   2 namespaces math slots parser eval ;
   3 IN: mirrors.tests
   4
   5 TUPLE: foo bar baz ;
   6
   7 C: <foo> foo
   8
   9 [ 2 ] [ 1 2 <foo> <mirror> assoc-size ] unit-test
  10
  11 [ { "bar" "baz" } ] [ 1 2 <foo> <mirror> keys ] unit-test
  12
  13 [ 1 t ] [ "bar" 1 2 <foo> <mirror> at* ] unit-test
  14
  15 [ f f ] [ "hi" 1 2 <foo> <mirror> at* ] unit-test
  16
  17 [ 3 ] [
  18     3 "baz" 1 2 <foo> [ <mirror> set-at ] keep baz>>
  19 ] unit-test
  20
  21 [ 3 "hi" 1 2 <foo> <mirror> set-at ] must-fail
  22
  23 [ 3 "numerator" 1/2 <mirror> set-at ] must-fail
  24
  25 [ "foo" ] [
  26     gensym [
  27         <mirror> [
  28             "foo" "name" set
  29         ] bind
  30     ] [ name>> ] bi
  31 ] unit-test
  32
  33 [ gensym <mirror> [ "compiled" off ] bind ] must-fail
  34
  35 TUPLE: declared-mirror-test
  36 { a integer initial: 0 } ;
  37
  38 [ 5 ] [
  39     3 declared-mirror-test boa <mirror> [
  40         5 "a" set
  41         "a" get
  42     ] bind
  43 ] unit-test
  44
  45 [ 3 declared-mirror-test boa <mirror> [ t "a" set ] bind ] must-fail
  46
  47 TUPLE: color
  48 { red integer }
  49 { green integer }
  50 { blue integer } ;
  51
  52 [ T{ color f 0 0 0 } ] [
  53     1 2 3 color boa [ <mirror> clear-assoc ] keep
  54 ] unit-test
  55
  56 ! Test reshaping with a mirror
  57 1 2 3 color boa <mirror> "mirror" set
  58
  59 [ ] [ "IN: mirrors.tests USE: math TUPLE: color { green integer } { red integer } { blue integer } ;" eval ] unit-test
  60
  61 [ 1 ] [ "red" "mirror" get at ] unit-test