extra/bake/fry/fry-tests.factor

   1
   2 USING: tools.test math prettyprint kernel io arrays vectors sequences
   3        generalizations bake bake.fry ;
   4
   5 IN: bake.fry.tests
   6
   7 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   8
   9 : unit-test* ( input output -- ) swap unit-test ;
  10
  11 : must-be-t ( in -- ) [ t ] swap unit-test ;
  12 : must-be-f ( in -- ) [ f ] swap unit-test ;
  13
  14 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  15
  16 [ [ 3 + ] ] [ 3 '[ , + ] ] unit-test
  17
  18 [ [ 1 3 + ] ] [ 1 3 '[ , , + ] ] unit-test
  19
  20 [ [ 1 + ] ] [ 1 [ + ] '[ , @ ] ] unit-test
  21
  22 [ [ 1 + . ] ] [ 1 [ + ] '[ , @ . ] ] unit-test
  23
  24 [ [ + - ] ] [ [ + ] [ - ] '[ @ @ ] ] unit-test
  25
  26 [ [ "a" write "b" print ] ]
  27 [ "a" "b" '[ , write , print ] ] unit-test
  28
  29 [ [ 1 2 + 3 4 - ] ]
  30 [ [ + ] [ - ] '[ 1 2 @ 3 4 @ ] ] unit-test
  31
  32 [ 1/2 ] [
  33     1 '[ , _ / ] 2 swap call
  34 ] unit-test
  35
  36 [ { { 1 "a" "A" } { 1 "b" "B" } { 1 "c" "C" } } ] [
  37     1 '[ , _ _ 3array ]
  38     { "a" "b" "c" } { "A" "B" "C" } rot 2map
  39 ] unit-test
  40
  41 [ { { 1 "a" } { 1 "b" } { 1 "c" } } ] [
  42     '[ 1 _ 2array ]
  43     { "a" "b" "c" } swap map
  44 ] unit-test
  45
  46 [ 1 2 ] [
  47     1 2 '[ _ , ] call
  48 ] unit-test
  49
  50 [ { { 1 "a" 2 } { 1 "b" 2 } { 1 "c" 2 } } ] [
  51     1 2 '[ , _ , 3array ]
  52     { "a" "b" "c" } swap map
  53 ] unit-test
  54
  55 : funny-dip '[ @ _ ] call ; inline
  56
  57 [ "hi" 3 ] [ "h" "i" 3 [ append ] funny-dip ] unit-test
  58
  59 [ { 1 2 3 } ] [
  60     3 1 '[ , [ , + ] map ] call
  61 ] unit-test
  62
  63 [ { 1 { 2 { 3 } } } ] [
  64     1 2 3 '[ , [ , [ , 1array ] call 2array ] call 2array ] call
  65 ] unit-test
  66
  67 { 1 1 } [ '[ [ [ , ] ] ] ] must-infer-as
  68
  69 [ { { { 3 } } } ] [
  70     3 '[ [ [ , 1array ] call 1array ] call 1array ] call
  71 ] unit-test
  72
  73 [ { { { 3 } } } ] [
  74     3 '[ [ [ , 1array ] call 1array ] call 1array ] call
  75 ] unit-test
  76
  77 ! [ 10 20 30 40 '[ , V{ , { , } } , ] ] [ [ 10 V{ 20 { 30 } } 40 ] ] unit-test*
  78
  79 [ 10 20 30 40 '[ , V{ , { , } } , ] ]
  80 [ [ 10 20 30 >r r> 1 narray >r >r r> r> 2 narray >vector 40 ] ]
  81 unit-test*
  82
  83 [ { 1 2 3 } { 4 5 6 } { 7 8 9 } '[ , { V{ @ } { , } } ] call ]
  84 [
  85   { 1 2 3 }
  86   { V{ 4 5 6 } { { 7 8 9 } } }
  87 ]
  88 unit-test*
  89