basis/functors/functors-tests.factor

   1 IN: functors.tests
   2 USING: functors tools.test math words kernel multiline parser
   3 io.streams.string generic ;
   4
   5 <<
   6
   7 FUNCTOR: define-box ( T -- )
   8
   9 B DEFINES-CLASS ${T}-box
  10 <B> DEFINES <${B}>
  11
  12 WHERE
  13
  14 TUPLE: B { value T } ;
  15
  16 C: <B> B
  17
  18 ;FUNCTOR
  19
  20 \ float define-box
  21
  22 >>
  23
  24 { 1 0 } [ define-box ] must-infer-as
  25
  26 [ T{ float-box f 5.0 } ] [ 5.0 <float-box> ] unit-test
  27
  28 : twice ( word -- )
  29     [ execute ] [ execute ] bi ; inline
  30 <<
  31
  32 FUNCTOR: wrapper-test ( W -- )
  33
  34 WW DEFINES ${W}${W}
  35
  36 WHERE
  37
  38 : WW ( a -- b ) \ W twice ; inline
  39
  40 ;FUNCTOR
  41
  42 \ sq wrapper-test
  43
  44 >>
  45
  46 \ sqsq must-infer
  47
  48 [ 16 ] [ 2 sqsq ] unit-test
  49
  50 <<
  51
  52 FUNCTOR: wrapper-test-2 ( W -- )
  53
  54 W DEFINES ${W}
  55
  56 WHERE
  57
  58 : W ( a b -- c ) \ + execute ;
  59
  60 ;FUNCTOR
  61
  62 "blah" wrapper-test-2
  63
  64 >>
  65
  66 [ 4 ] [ 1 3 blah ] unit-test
  67
  68 GENERIC: some-generic ( a -- b )
  69
  70 ! Does replacing an ordinary word with a functor-generated one work?
  71 [ [ ] ] [
  72     <" IN: functors.tests
  73
  74     TUPLE: some-tuple ;
  75     : some-word ( -- ) ;
  76     M: some-tuple some-generic ;
  77     "> <string-reader> "functors-test" parse-stream
  78 ] unit-test
  79
  80 : test-redefinition ( -- )
  81     [ t ] [ "some-word" "functors.tests" lookup >boolean ] unit-test
  82     [ t ] [ "some-tuple" "functors.tests" lookup >boolean ] unit-test
  83     [ t ] [
  84         "some-tuple" "functors.tests" lookup
  85         "some-generic" "functors.tests" lookup method >boolean
  86     ] unit-test ;
  87
  88 test-redefinition
  89
  90 FUNCTOR: redefine-test ( W -- )
  91
  92 W-word DEFINES ${W}-word
  93 W-tuple DEFINES-CLASS ${W}-tuple
  94 W-generic IS ${W}-generic
  95
  96 WHERE
  97
  98 TUPLE: W-tuple ;
  99 : W-word ( -- ) ;
 100 M: W-tuple W-generic ;
 101
 102 ;FUNCTOR
 103
 104 [ [ ] ] [
 105     <" IN: functors.tests
 106     << "some" redefine-test >>
 107     "> <string-reader> "functors-test" parse-stream
 108 ] unit-test
 109
 110 test-redefinition