core/slots/slots-tests.factor

   1 USING: math accessors slots strings generic.single kernel
   2 tools.test generic words parser eval math.functions arrays ;
   3 IN: slots.tests
   4
   5 TUPLE: r/w-test foo ;
   6
   7 TUPLE: r/o-test { foo read-only } ;
   8
   9 [ r/o-test new 123 >>foo ] [ no-method? ] must-fail-with
  10
  11 TUPLE: decl-test { foo array } ;
  12
  13 [ decl-test new "" >>foo ] [ bad-slot-value? ] must-fail-with
  14
  15 TUPLE: hello length ;
  16
  17 [ 3 ] [ "xyz" length>> ] unit-test
  18
  19 [ "xyz" 4 >>length ] [ no-method? ] must-fail-with
  20
  21 ! Test protocol slots
  22 SLOT: my-protocol-slot-test
  23
  24 TUPLE: protocol-slot-test-tuple x ;
  25
  26 M: protocol-slot-test-tuple my-protocol-slot-test>> x>> sq ;
  27 M: protocol-slot-test-tuple my-protocol-slot-test<< [ sqrt ] dip x<< ;
  28
  29 [ 9 ] [ T{ protocol-slot-test-tuple { x 3 } } my-protocol-slot-test>> ] unit-test
  30
  31 [ 4.0 ] [
  32     T{ protocol-slot-test-tuple { x 3 } } clone
  33     [ 7 + ] change-my-protocol-slot-test x>>
  34 ] unit-test
  35
  36 UNION: comme-ci integer float ;
  37 UNION: comme-ca integer float ;
  38 comme-ca 25.5 "initial-value" set-word-prop
  39
  40 [ 0 t ]    [ comme-ci initial-value ] unit-test
  41 [ 25.5 t ] [ comme-ca initial-value ] unit-test