basis/fry/fry-tests.factor

   1 USING: fry tools.test math prettyprint kernel io arrays
   2 sequences eval accessors ;
   3 IN: fry.tests
   4
   5 [ [ 3 + ] ] [ 3 '[ _ + ] ] unit-test
   6
   7 [ [ 1 3 + ] ] [ 1 3 '[ _ _ + ] ] unit-test
   8
   9 [ [ 1 [ + ] call ] ] [ 1 [ + ] '[ _ @ ] ] unit-test
  10
  11 [ [ 1 [ + ] call . ] ] [ 1 [ + ] '[ _ @ . ] ] unit-test
  12
  13 [ [ [ + ] [ - ] [ call ] dip call ] ] [ [ + ] [ - ] '[ @ @ ] ] unit-test
  14
  15 [ [ "a" "b" [ write ] dip print ] ]
  16 [ "a" "b" '[ _ write _ print ] ] unit-test
  17
  18 [ 1/2 ] [
  19     1 '[ [ _ ] dip / ] 2 swap call
  20 ] unit-test
  21
  22 [ { { 1 "a" "A" } { 1 "b" "B" } { 1 "c" "C" } } ] [
  23     1 '[ [ _ ] 2dip 3array ]
  24     { "a" "b" "c" } { "A" "B" "C" } rot 2map
  25 ] unit-test
  26
  27 [ { { 1 "a" } { 1 "b" } { 1 "c" } } ] [
  28     '[ [ 1 ] dip 2array ]
  29     { "a" "b" "c" } swap map
  30 ] unit-test
  31
  32 [ { { 1 "a" 2 } { 1 "b" 2 } { 1 "c" 2 } } ] [
  33     1 2 '[ [ _ ] dip _ 3array ]
  34     { "a" "b" "c" } swap map
  35 ] unit-test
  36
  37 : funny-dip ( obj quot -- ) '[ [ @ ] dip ] call ; inline
  38
  39 [ "hi" 3 ] [ "h" "i" 3 [ append ] funny-dip ] unit-test
  40
  41 [ { 1 2 3 } ] [
  42     3 1 '[ _ [ _ + ] map ] call
  43 ] unit-test
  44
  45 [ { 1 { 2 { 3 } } } ] [
  46     1 2 3 '[ _ [ _ [ _ 1array ] call 2array ] call 2array ] call
  47 ] unit-test
  48
  49 { 1 1 } [ '[ [ [ _ ] ] ] ] must-infer-as
  50
  51 [ { { { 3 } } } ] [
  52     3 '[ [ [ _ 1array ] call 1array ] call 1array ] call
  53 ] unit-test
  54
  55 [ { { { 3 } } } ] [
  56     3 '[ [ [ _ 1array ] call 1array ] call 1array ] call
  57 ] unit-test
  58
  59 [ "USING: fry locals.backend ; f '[ load-local _ ]" eval( -- quot ) ]
  60 [ error>> >r/r>-in-fry-error? ] must-fail-with
  61
  62 [ { { "a" 1 } { "b" 2 } { "c" 3 } { "d" 4 } } ] [
  63     1 2 3 4 '[ "a" _ 2array "b" _ 2array "c" _ 2array "d" _ 2array 4array ] call
  64 ] unit-test