basis/compiler/tests/redefine0.factor

   1 IN: compiler.tests.redefine0
   2 USING: tools.test eval compiler compiler.errors compiler.units definitions kernel math ;
   3
   4 ! Test ripple-up behavior
   5 : test-1 ( -- a ) 3 ;
   6 : test-2 ( -- ) test-1 ;
   7
   8 [ test-2 ] [ not-compiled? ] must-fail-with
   9
  10 [ ] [ "IN: compiler.tests.redefine0 : test-1 ( -- ) ;" eval( -- ) ] unit-test
  11
  12 { 0 0 } [ test-1 ] must-infer-as
  13
  14 [ ] [ test-2 ] unit-test
  15
  16 [ ] [
  17     [
  18         \ test-1 forget
  19         \ test-2 forget
  20     ] with-compilation-unit
  21 ] unit-test
  22
  23 : test-3 ( a -- ) drop ;
  24 : test-4 ( -- ) [ 1 2 3 ] test-3 ;
  25
  26 [ ] [ test-4 ] unit-test
  27
  28 [ ] [ "IN: compiler.tests.redefine0 USE: kernel : test-3 ( a -- ) call ; inline" eval( -- ) ] unit-test
  29
  30 [ test-4 ] [ not-compiled? ] must-fail-with
  31
  32 [ ] [
  33     [
  34         \ test-3 forget
  35         \ test-4 forget
  36     ] with-compilation-unit
  37 ] unit-test
  38
  39 : test-5 ( a -- quot ) ;
  40 : test-6 ( a -- b ) test-5 ;
  41
  42 [ 31337 ] [ 31337 test-6 ] unit-test
  43
  44 [ ] [ "IN: compiler.tests.redefine0 USING: macros kernel ; MACRO: test-5 ( a -- quot ) drop [ ] ;" eval( -- ) ] unit-test
  45
  46 [ 31337 test-6 ] [ not-compiled? ] must-fail-with
  47
  48 [ ] [
  49     [
  50         \ test-5 forget
  51         \ test-6 forget
  52     ] with-compilation-unit
  53 ] unit-test
  54
  55 GENERIC: test-7 ( a -- b )
  56
  57 M: integer test-7 + ;
  58
  59 : test-8 ( a -- b ) 255 bitand test-7 ;
  60
  61 [ 1 test-7 ] [ not-compiled? ] must-fail-with
  62 [ 1 test-8 ] [ not-compiled? ] must-fail-with
  63
  64 [ ] [ "IN: compiler.tests.redefine0 USING: macros kernel ; GENERIC: test-7 ( x y -- z )" eval( -- ) ] unit-test
  65
  66 [ 4 ] [ 1 3 test-7 ] unit-test
  67 [ 4 ] [ 1 259 test-8 ] unit-test
  68
  69 [ ] [
  70     [
  71         \ test-7 forget
  72         \ test-8 forget
  73     ] with-compilation-unit
  74 ] unit-test