basis/compiler/tests/redefine0.factor

   1 USING: tools.test eval compiler compiler.errors compiler.units definitions kernel math
   2 namespaces macros assocs ;
   3 IN: compiler.tests.redefine0
   4
   5 ! Test ripple-up behavior
   6 : test-1 ( -- a ) 3 ;
   7 : test-2 ( -- ) test-1 ;
   8
   9 [ test-2 ] [ not-compiled? ] must-fail-with
  10
  11 [ ] [ "IN: compiler.tests.redefine0 : test-1 ( -- ) ;" eval( -- ) ] unit-test
  12
  13 { 0 0 } [ test-1 ] must-infer-as
  14
  15 [ ] [ test-2 ] unit-test
  16
  17 [ ] [
  18     [
  19         \ test-1 forget
  20         \ test-2 forget
  21     ] with-compilation-unit
  22 ] unit-test
  23
  24 : test-3 ( a -- ) drop ;
  25 : test-4 ( -- ) [ 1 2 3 ] test-3 ;
  26
  27 [ ] [ test-4 ] unit-test
  28
  29 [ ] [ "IN: compiler.tests.redefine0 USE: kernel : test-3 ( a -- ) call ; inline" eval( -- ) ] unit-test
  30
  31 [ test-4 ] [ not-compiled? ] must-fail-with
  32
  33 [ ] [
  34     [
  35         \ test-3 forget
  36         \ test-4 forget
  37     ] with-compilation-unit
  38 ] unit-test
  39
  40 : test-5 ( a -- quot ) ;
  41 : test-6 ( a -- b ) test-5 ;
  42
  43 [ 31337 ] [ 31337 test-6 ] unit-test
  44
  45 [ ] [ "IN: compiler.tests.redefine0 USING: macros kernel ; MACRO: test-5 ( a -- quot ) drop [ ] ;" eval( -- ) ] unit-test
  46
  47 [ 31337 test-6 ] [ not-compiled? ] must-fail-with
  48
  49 [ ] [
  50     [
  51         \ test-5 forget
  52         \ test-6 forget
  53     ] with-compilation-unit
  54 ] unit-test
  55
  56 GENERIC: test-7 ( a -- b )
  57
  58 M: integer test-7 + ;
  59
  60 : test-8 ( a -- b ) 255 bitand test-7 ;
  61
  62 [ 1 test-7 ] [ not-compiled? ] must-fail-with
  63 [ 1 test-8 ] [ not-compiled? ] must-fail-with
  64
  65 [ ] [ "IN: compiler.tests.redefine0 USING: macros math kernel ; GENERIC: test-7 ( x y -- z ) : test-8 ( a b -- c ) 255 bitand test-7 ;" eval( -- ) ] unit-test
  66
  67 [ 4 ] [ 1 3 test-7 ] unit-test
  68 [ 4 ] [ 1 259 test-8 ] unit-test
  69
  70 [ ] [
  71     [
  72         \ test-7 forget
  73         \ test-8 forget
  74     ] with-compilation-unit
  75 ] unit-test
  76
  77 ! Indirect dependency on an unoptimized word
  78 : test-9 ( -- ) ;
  79 << SYMBOL: quot
  80 [ test-9 ] quot set-global >>
  81 MACRO: test-10 ( -- quot ) quot get ;
  82 : test-11 ( -- ) test-10 ;
  83
  84 [ ] [ test-11 ] unit-test
  85
  86 [ ] [ "IN: compiler.tests.redefine0 : test-9 ( -- ) 1 ;" eval( -- ) ] unit-test
  87
  88 ! test-11 should get recompiled now
  89
  90 [ test-11 ] [ not-compiled? ] must-fail-with
  91
  92 [ ] [ "IN: compiler.tests.redefine0 : test-9 ( -- a ) 1 ;" eval( -- ) ] unit-test
  93
  94 [ ] [ "IN: compiler.tests.redefine0 : test-9 ( -- ) ;" eval( -- ) ] unit-test
  95
  96 [ ] [ test-11 ] unit-test
  97
  98 quot global delete-at
  99
 100 [ ] [
 101     [
 102         \ test-9 forget
 103         \ test-10 forget
 104         \ test-11 forget
 105         \ quot forget
 106     ] with-compilation-unit
 107 ] unit-test