basis/functors/functors-tests.factor

   1 IN: functors.tests
   2 USING: functors tools.test math words kernel ;
   3
   4 <<
   5
   6 FUNCTOR: define-box ( T -- )
   7
   8 B DEFINES ${T}-box
   9 <B> DEFINES <${B}>
  10
  11 WHERE
  12
  13 TUPLE: B { value T } ;
  14
  15 C: <B> B
  16
  17 ;FUNCTOR
  18
  19 \ float define-box
  20
  21 >>
  22
  23 { 1 0 } [ define-box ] must-infer-as
  24
  25 [ T{ float-box f 5.0 } ] [ 5.0 <float-box> ] unit-test
  26
  27 : twice ( word -- )
  28     [ execute ] [ execute ] bi ; inline
  29 <<
  30
  31 FUNCTOR: wrapper-test ( W -- )
  32
  33 WW DEFINES ${W}${W}
  34
  35 WHERE
  36
  37 : WW W twice ; inline
  38
  39 ;FUNCTOR
  40
  41 \ sq wrapper-test
  42
  43 >>
  44
  45 \ sqsq must-infer
  46
  47 [ 16 ] [ 2 sqsq ] unit-test