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         ] with-variables
  30     ] [ name>> ] bi
  31 ] unit-test
  32
  33 [ gensym <mirror> [ "compiled" off ] with-variables ] 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     ] with-variables
  43 ] unit-test
  44
  45 [ 3 declared-mirror-test boa <mirror> [ t "a" set ] with-variables ] must-fail
  46
  47 TUPLE: color
  48 { red integer }
  49 { green integer }
  50 { blue integer } ;
  51
  52 [ \ + make-mirror clear-assoc ] [ mirror-slot-removal? ] must-fail-with
  53 [ \ + make-mirror [ "name" ] dip delete-at ] [ mirror-slot-removal? ] must-fail-with
  54
  55 ! Test reshaping with a mirror
  56 1 2 3 color boa <mirror> "mirror" set
  57
  58 { } [ "IN: mirrors.tests USE: math TUPLE: color { green integer } { red integer } { blue integer } ;" eval( -- ) ] unit-test
  59
  60 { 1 } [ "red" "mirror" get at ] unit-test
  61
  62 { 3 } [ { 1 2 3 } make-mirror assoc-size ] unit-test
  63 { 4 } [ "asdf" make-mirror assoc-size ] unit-test
  64 { 8 } [ \ + make-mirror assoc-size ] unit-test