basis/compiler/tests/redefine1.factor

   1 USING: accessors compiler compiler.units tools.test math parser
   2 kernel sequences sequences.private classes.mixin generic
   3 definitions arrays words assocs eval ;
   4 IN: compiler.tests
   5
   6 GENERIC: method-redefine-test ( a -- b )
   7
   8 M: integer method-redefine-test 3 + ;
   9
  10 : method-redefine-test-1 ( -- b ) 3 method-redefine-test ;
  11
  12 [ 6 ] [ method-redefine-test-1 ] unit-test
  13
  14 [ ] [ "IN: compiler.tests USE: math M: fixnum method-redefine-test 4 + ;" eval ] unit-test
  15
  16 [ 7 ] [ method-redefine-test-1 ] unit-test
  17
  18 [ ] [ [ fixnum \ method-redefine-test method forget ] with-compilation-unit ] unit-test
  19
  20 [ 6 ] [ method-redefine-test-1 ] unit-test
  21
  22 ! Test ripple-up behavior
  23 : hey ( -- ) ;
  24 : there ( -- ) hey ;
  25
  26 [ t ] [ \ hey optimized>> ] unit-test
  27 [ t ] [ \ there optimized>> ] unit-test
  28 [ ] [ "IN: compiler.tests : hey ( -- ) 3 ;" eval ] unit-test
  29 [ f ] [ \ hey optimized>> ] unit-test
  30 [ f ] [ \ there optimized>> ] unit-test
  31 [ ] [ "IN: compiler.tests : hey ( -- ) ;" eval ] unit-test
  32 [ t ] [ \ there optimized>> ] unit-test
  33
  34 : good ( -- ) ;
  35 : bad ( -- ) good ;
  36 : ugly ( -- ) bad ;
  37
  38 [ t ] [ \ good optimized>> ] unit-test
  39 [ t ] [ \ bad optimized>> ] unit-test
  40 [ t ] [ \ ugly optimized>> ] unit-test
  41
  42 [ f ] [ \ good compiled-usage assoc-empty? ] unit-test
  43
  44 [ ] [ "IN: compiler.tests : good ( -- ) 3 ;" eval ] unit-test
  45
  46 [ f ] [ \ good optimized>> ] unit-test
  47 [ f ] [ \ bad optimized>> ] unit-test
  48 [ f ] [ \ ugly optimized>> ] unit-test
  49
  50 [ t ] [ \ good compiled-usage assoc-empty? ] unit-test
  51
  52 [ ] [ "IN: compiler.tests : good ( -- ) ;" eval ] unit-test
  53
  54 [ t ] [ \ good optimized>> ] unit-test
  55 [ t ] [ \ bad optimized>> ] unit-test
  56 [ t ] [ \ ugly optimized>> ] unit-test
  57
  58 [ f ] [ \ good compiled-usage assoc-empty? ] unit-test