basis/fry/fry-tests.factor

   1 ! Copyright (C) 2009 Slava Pestov, Eduardo Cavazos, Joe Groff.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: fry tools.test math prettyprint kernel io arrays
   4 sequences eval accessors ;
   5 IN: fry.tests
   6
   7 SYMBOLS: a b c d e f g h ;
   8
   9 [ [ ] ] [ '[ ] ] unit-test
  10 [ [ + ] ] [ '[ + ] ] unit-test
  11 [ [ 1 ] ] [ 1 '[ _ ] ] unit-test
  12 [ [ 1 ] ] [ [ 1 ] '[ @ ] ] unit-test
  13 [ [ 1 2 ] ] [ [ 1 ] [ 2 ] '[ @ @ ] ] unit-test
  14
  15 [ [ 1 2 a ] ] [ 1 2 '[ _ _ a ] ] unit-test
  16 [ [ 1 2 ] ] [ 1 2 '[ _ _ ] ] unit-test
  17 [ [ a 1 2 ] ] [ 1 2 '[ a _ _ ] ] unit-test
  18 [ [ 1 2 a ] ] [ [ 1 ] [ 2 ] '[ @ @ a ] ] unit-test
  19 [ [ 1 a 2 b ] ] [ 1 2 '[ _ a _ b ] ] unit-test
  20 [ [ 1 a 2 b ] ] [ 1 [ 2 ] '[ _ a @ b ] ] unit-test
  21 [ [ a 1 b ] ] [ 1 '[ a _ b ] ] unit-test
  22
  23 [ [ a 1 b ] ] [ [ 1 ] '[ a @ b ] ] unit-test
  24 [ [ a 1 2 ] ] [ [ 1 ] [ 2 ] '[ a @ @ ] ] unit-test
  25
  26 [ [ a [ 1 ] b ] ] [ 1 '[ a [ _ ] b ] ] unit-test
  27 [ [ a 1 b [ c 2 d ] e 3 f ] ] [ 1 2 3 '[ a _ b [ c _ d ] e _ f ] ] unit-test
  28 [ [ a 1 b [ c 2 d [ e 3 f ] ] g 4 h ] ] [ 1 2 3 4 '[ a _ b [ c _ d [ e _ f ] ] g _ h ] ] unit-test
  29 [ [ a 1 b [ [ c 2 d ] e 3 f ] g 4 h ] ] [ 1 2 3 4 '[ a _ b [ [ c _ d ] e _ f ] g _ h ] ] unit-test
  30
  31 [ [ 3 + ] ] [ 3 '[ _ + ] ] unit-test
  32
  33 [ [ 1 3 + ] ] [ 1 3 '[ _ _ + ] ] unit-test
  34
  35 [ [ 1 + ] ] [ 1 [ + ] '[ _ @ ] ] unit-test
  36
  37 [ [ 1 + . ] ] [ 1 [ + ] '[ _ @ . ] ] unit-test
  38
  39 [ [ + - ] ] [ [ + ] [ - ] '[ @ @ ] ] unit-test
  40
  41 [ [ "a" write "b" print ] ]
  42 [ "a" "b" '[ _ write _ print ] ] unit-test
  43
  44 [ 1/2 ] [
  45     1 '[ [ _ ] dip / ] 2 swap call
  46 ] unit-test
  47
  48 [ { { 1 "a" "A" } { 1 "b" "B" } { 1 "c" "C" } } ] [
  49     1 '[ [ _ ] 2dip 3array ]
  50     { "a" "b" "c" } { "A" "B" "C" } rot 2map
  51 ] unit-test
  52
  53 [ { { 1 "a" } { 1 "b" } { 1 "c" } } ] [
  54     '[ [ 1 ] dip 2array ]
  55     { "a" "b" "c" } swap map
  56 ] unit-test
  57
  58 [ { { 1 "a" 2 } { 1 "b" 2 } { 1 "c" 2 } } ] [
  59     1 2 '[ [ _ ] dip _ 3array ]
  60     { "a" "b" "c" } swap map
  61 ] unit-test
  62
  63 : funny-dip ( obj quot -- ) '[ [ @ ] dip ] call ; inline
  64
  65 [ "hi" 3 ] [ "h" "i" 3 [ append ] funny-dip ] unit-test
  66
  67 [ { 1 2 3 } ] [
  68     3 1 '[ _ iota [ _ + ] map ] call
  69 ] unit-test
  70
  71 [ { 1 { 2 { 3 } } } ] [
  72     1 2 3 '[ _ [ _ [ _ 1array ] call 2array ] call 2array ] call
  73 ] unit-test
  74
  75 { 1 1 } [ '[ [ [ _ ] ] ] ] must-infer-as
  76
  77 [ { { { 3 } } } ] [
  78     3 '[ [ [ _ 1array ] call 1array ] call 1array ] call
  79 ] unit-test
  80
  81 [ { { { 3 } } } ] [
  82     3 '[ [ [ _ 1array ] call 1array ] call 1array ] call
  83 ] unit-test
  84
  85 [ "USING: fry locals.backend ; f '[ load-local _ ]" eval( -- quot ) ]
  86 [ error>> >r/r>-in-fry-error? ] must-fail-with
  87
  88 [ { { "a" 1 } { "b" 2 } { "c" 3 } { "d" 4 } } ] [
  89     1 2 3 4 '[ "a" _ 2array "b" _ 2array "c" _ 2array "d" _ 2array 4array ] call
  90 ] unit-test