basis/tools/walker/walker-tests.factor

   1 USING: tools.walker io io.streams.string kernel math
   2 math.private namespaces prettyprint sequences tools.test
   3 continuations math.parser threads arrays tools.walker.debug
   4 generic.single sequences.private kernel.private
   5 tools.continuations accessors words combinators ;
   6 IN: tools.walker.tests
   7
   8 [ { } ] [
   9     [ ] test-walker
  10 ] unit-test
  11
  12 [ { 1 } ] [
  13     [ 1 ] test-walker
  14 ] unit-test
  15
  16 [ { 1 2 3 } ] [
  17     [ 1 2 3 ] test-walker
  18 ] unit-test
  19
  20 [ { "Yo" 2 } ] [
  21     [ 2 [ "Yo" ] dip ] test-walker
  22 ] unit-test
  23
  24 [ { "Yo" 2 3 } ] [
  25     [ 2 [ "Yo" ] dip 3 ] test-walker
  26 ] unit-test
  27
  28 [ { 2 } ] [
  29     [ t [ 2 ] [ "hi" ] if ] test-walker
  30 ] unit-test
  31
  32 [ { "hi" } ] [
  33     [ f [ 2 ] [ "hi" ] if ] test-walker
  34 ] unit-test
  35
  36 [ { 4 } ] [
  37     [ 2 2 fixnum+ ] test-walker
  38 ] unit-test
  39
  40 : foo ( -- x ) 2 2 fixnum+ ;
  41
  42 [ { 8 } ] [
  43     [ foo 4 fixnum+ ] test-walker
  44 ] unit-test
  45
  46 [ { C{ 1 1.5 } { } C{ 1 1.5 } { } } ] [
  47     [ C{ 1 1.5 } { } 2dup ] test-walker
  48 ] unit-test
  49
  50 [ { t } ] [
  51     [ 5 5 number= ] test-walker
  52 ] unit-test
  53
  54 [ { f } ] [
  55     [ 5 6 number= ] test-walker
  56 ] unit-test
  57
  58 [ { 0 } ] [
  59     [ 0 { array-capacity } declare ] test-walker
  60 ] unit-test
  61
  62 [ { f } ] [
  63     [ "XYZ" "XYZ" mismatch ] test-walker
  64 ] unit-test
  65
  66 [ { t } ] [
  67     [ "XYZ" "XYZ" sequence= ] test-walker
  68 ] unit-test
  69
  70 [ { t } ] [
  71     [ "XYZ" "XYZ" = ] test-walker
  72 ] unit-test
  73
  74 [ { f } ] [
  75     [ "XYZ" "XuZ" = ] test-walker
  76 ] unit-test
  77
  78 [ { 4 } ] [
  79     [ 2 2 + ] test-walker
  80 ] unit-test
  81
  82 [ { 3 } ] [
  83     [ [ 3 "x" set "x" get ] with-scope ] test-walker
  84 ] unit-test
  85
  86 [ { "hi\n" } ] [
  87     [ [ "hi" print ] with-string-writer ] test-walker
  88 ] unit-test
  89
  90 [ { "4\n" } ] [
  91     [ [ 2 2 + number>string print ] with-string-writer ] test-walker
  92 ] unit-test
  93
  94 [ { 1 2 3 } ] [
  95     [ { 1 2 3 } set-datastack ] test-walker
  96 ] unit-test
  97
  98 [ { 6 } ]
  99 [ [ 3 [ nip continue ] callcc0 2 * ] test-walker ] unit-test
 100
 101 [ { 6 } ]
 102 [ [ [ 3 swap continue-with ] callcc1 2 * ] test-walker ] unit-test
 103
 104 [ { } ]
 105 [ [ [ ] [ ] recover ] test-walker ] unit-test
 106
 107 [ { 6 } ]
 108 [ [ [ 3 throw ] [ 2 * ] recover ] test-walker ] unit-test
 109
 110 [ { T{ no-method f + nth } } ]
 111 [ [ [ 0 \ + nth ] [ ] recover ] test-walker ] unit-test
 112
 113 [ { } ] [
 114     [ "a" "b" set "c" "d" set [ ] test-walker ] with-scope
 115 ] unit-test
 116
 117 : breakpoint-test ( -- x ) break 1 2 + ;
 118
 119 \ breakpoint-test don't-step-into
 120
 121 [ f ] [ \ breakpoint-test optimized? ] unit-test
 122
 123 [ { 3 } ] [ [ breakpoint-test ] test-walker ] unit-test
 124
 125 GENERIC: method-breakpoint-test ( x -- y )
 126
 127 TUPLE: method-breakpoint-tuple ;
 128
 129 M: method-breakpoint-tuple method-breakpoint-test break drop 1 2 + ;
 130
 131 \ method-breakpoint-test don't-step-into
 132
 133 [ { 3 } ]
 134 [ [ T{ method-breakpoint-tuple } method-breakpoint-test ] test-walker ] unit-test
 135
 136 : case-breakpoint-test ( -- x )
 137     5 { [ break 1 + ] } case ;
 138
 139 \ case-breakpoint-test don't-step-into
 140
 141 [ { 6 } ] [ [ case-breakpoint-test ] test-walker ] unit-test
 142
 143 : call(-breakpoint-test ( -- x )
 144     [ break 1 ] call( -- x ) 2 + ;
 145
 146 \ call(-breakpoint-test don't-step-into
 147
 148 [ { 3 } ] [ [ call(-breakpoint-test ] test-walker ] unit-test