basis/compiler/tests/redefine1.factor

   1 IN: compiler.tests
   2 USING: accessors compiler compiler.units tools.test math parser
   3 kernel sequences sequences.private classes.mixin generic
   4 definitions arrays words assocs ;
   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 compiled>> ] unit-test
  27 [ t ] [ \ there compiled>> ] unit-test
  28 [ ] [ "IN: compiler.tests : hey ( -- ) 3 ;" eval ] unit-test
  29 [ f ] [ \ hey compiled>> ] unit-test
  30 [ f ] [ \ there compiled>> ] unit-test
  31 [ ] [ "IN: compiler.tests : hey ( -- ) ;" eval ] unit-test
  32 [ t ] [ \ there compiled>> ] unit-test
  33
  34 ! Just changing the stack effect didn't mark a word for recompilation
  35 DEFER: change-effect
  36
  37 [ ] [ "IN: compiler.tests GENERIC: change-effect ( a -- b )" eval ] unit-test
  38 { 1 1 } [ change-effect ] must-infer-as
  39
  40 [ ] [ "IN: compiler.tests GENERIC: change-effect ( a -- )" eval ] unit-test
  41 { 1 0 } [ change-effect ] must-infer-as
  42
  43 : good ( -- ) ;
  44 : bad ( -- ) good ;
  45 : ugly ( -- ) bad ;
  46
  47 [ t ] [ \ good compiled>> ] unit-test
  48 [ t ] [ \ bad compiled>> ] unit-test
  49 [ t ] [ \ ugly compiled>> ] unit-test
  50
  51 [ f ] [ \ good compiled-usage assoc-empty? ] unit-test
  52
  53 [ ] [ "IN: compiler.tests : good ( -- ) 3 ;" eval ] unit-test
  54
  55 [ f ] [ \ good compiled>> ] unit-test
  56 [ f ] [ \ bad compiled>> ] unit-test
  57 [ f ] [ \ ugly compiled>> ] unit-test
  58
  59 [ t ] [ \ good compiled-usage assoc-empty? ] unit-test
  60
  61 [ ] [ "IN: compiler.tests : good ( -- ) ;" eval ] unit-test
  62
  63 [ t ] [ \ good compiled>> ] unit-test
  64 [ t ] [ \ bad compiled>> ] unit-test
  65 [ t ] [ \ ugly compiled>> ] unit-test
  66
  67 [ f ] [ \ good compiled-usage assoc-empty? ] unit-test