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 ( T -- 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 [ 16 ] [ 2 sqsq ] unit-test
  47
  48 <<
  49
  50 FUNCTOR: wrapper-test-2 ( W -- )
  51
  52 W DEFINES ${W}
  53
  54 WHERE
  55
  56 : W ( a b -- c ) \ + execute ;
  57
  58 ;FUNCTOR
  59
  60 "blah" wrapper-test-2
  61
  62 >>
  63
  64 [ 4 ] [ 1 3 blah ] unit-test
  65
  66 GENERIC: some-generic ( a -- b )
  67
  68 ! Does replacing an ordinary word with a functor-generated one work?
  69 [ [ ] ] [
  70     <" IN: functors.tests
  71
  72     TUPLE: some-tuple ;
  73     : some-word ( -- ) ;
  74     M: some-tuple some-generic ;
  75     "> <string-reader> "functors-test" parse-stream
  76 ] unit-test
  77
  78 : test-redefinition ( -- )
  79     [ t ] [ "some-word" "functors.tests" lookup >boolean ] unit-test
  80     [ t ] [ "some-tuple" "functors.tests" lookup >boolean ] unit-test
  81     [ t ] [
  82         "some-tuple" "functors.tests" lookup
  83         "some-generic" "functors.tests" lookup method >boolean
  84     ] unit-test ;
  85
  86 test-redefinition
  87
  88 FUNCTOR: redefine-test ( W -- )
  89
  90 W-word DEFINES ${W}-word
  91 W-tuple DEFINES-CLASS ${W}-tuple
  92 W-generic IS ${W}-generic
  93
  94 WHERE
  95
  96 TUPLE: W-tuple ;
  97 : W-word ( -- ) ;
  98 M: W-tuple W-generic ;
  99
 100 ;FUNCTOR
 101
 102 [ [ ] ] [
 103     <" IN: functors.tests
 104     << "some" redefine-test >>
 105     "> <string-reader> "functors-test" parse-stream
 106 ] unit-test
 107
 108 test-redefinition