1 ! Copyright (C) 2013 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: arrays assocs combinators.extras io.files kernel math
4 modern.slices sequences splitting tools.test ;
5 IN: combinators.extras.tests
9 [ "a" "b" [ " " glue ] once ] unit-test
12 [ "a" "b" "c" [ " " glue ] twice ] unit-test
15 [ "a" "b" "c" "d" [ " " glue ] thrice ] unit-test
17 { { "negative" 0 "positive" } } [
20 { [ 0 > ] [ "positive" ] }
21 { [ 0 < ] [ "negative" ] }
27 { { 1 2 3 } } [ 1 { [ ] [ 1 + ] [ 2 + ] } cleave-array ] unit-test
29 { 2 15 } [ 1 2 3 4 5 6 [ - - ] [ + + ] 3bi* ] unit-test
31 { 2 5 } [ 1 2 3 4 5 6 [ - - ] 3bi@ ] unit-test
33 { 3 1 } [ 1 2 [ + ] keepd ] unit-test
35 { "1" "123" } [ "1" "123" [ length ] [ > ] swap-when ] unit-test
36 { "123" "1" } [ "1" "123" [ length ] [ < ] swap-when ] unit-test
39 { t } [ "resource:" [ file-exists? ] ?1arg >boolean ] unit-test
40 { f } [ f [ file-exists? ] ?1arg ] unit-test
41 { f } [ "/homeasdfasdf123123" [ file-exists? ] ?1arg ] unit-test
45 { [ "there" over subseq-start ] [ cut ] }
52 { [ "foo" over subseq-start ] [ head f ] }
53 { [ "there" over subseq-start ] [ cut ] }
60 { [ "foo" over subseq-start ] [ head f ] }
61 { [ "bar" over subseq-start ] [ cut ] }
66 { f } [ f { } chain ] unit-test
67 { 3 } [ H{ { 1 H{ { 2 3 } } } } { [ 1 of ] [ 2 of ] } chain ] unit-test
68 { f } [ H{ { 1 H{ { 3 4 } } } } { [ 1 of ] [ 2 of ] } chain ] unit-test
69 { f } [ H{ { 2 H{ { 3 4 } } } } { [ 1 of ] [ 2 of ] } chain ] unit-test
71 "hello factor!" { [ split-words ] [ first ] [ length ] } chain
81 [ 4array ] [ 4array ] [ 4array ] [ 4array ] 4quad
89 1 2 3 4 5 6 7 8 9 10 11 12
90 [ 4array ] [ 4array ] [ 4array ] 4tri*
98 1 2 3 4 5 6 7 8 9 10 11 12
102 { 1 2 3 } [ 1 2 [ 3 ] dip-1up ] unit-test
103 { 2 2 } [ 1 2 [ 1 + ] dip-1up ] unit-test
104 { 20 11 } [ 10 20 [ 1 + ] dip-1up ] unit-test
106 { 0 10 20 30 40 50 60 80 71 } [ 0 10 20 30 40 50 60 70 80 [ 1 + ] dip-1up ] unit-test
107 { 0 10 20 30 40 50 70 80 61 } [ 0 10 20 30 40 50 60 70 80 [ 1 + ] 2dip-1up ] unit-test
108 { 0 10 20 30 40 60 70 80 51 } [ 0 10 20 30 40 50 60 70 80 [ 1 + ] 3dip-1up ] unit-test
111 { 0 10 20 30 40 50 80 61 71 } [ 0 10 20 30 40 50 60 70 80 [ [ 1 + ] bi@ ] dip-2up ] unit-test
112 { 0 10 20 30 40 70 80 51 61 } [ 0 10 20 30 40 50 60 70 80 [ [ 1 + ] bi@ ] 2dip-2up ] unit-test
113 { 0 10 20 30 60 70 80 41 51 } [ 0 10 20 30 40 50 60 70 80 [ [ 1 + ] bi@ ] 3dip-2up ] unit-test
115 { 0 10 20 60 70 80 31 41 51 } [ 0 10 20 30 40 50 60 70 80 [ [ 1 + ] tri@ ] 3dip-3up ] unit-test
117 { 4 "abcd" 97 98 99 100 } [
119 [ [ CHAR: a = ] accept1 ]
120 [ [ CHAR: b = ] accept1 ]
121 [ [ CHAR: c = ] accept1 ]
122 [ [ CHAR: d = ] accept1 ] 4craft-1up
125 { 20 30 2500 } [ 20 30 [ + sq ] 2keep-1up ] unit-test
127 { 10 1 } [ 10 [ drop 1 ] keep-1up ] unit-test
128 { 10 20 1 } [ 10 20 [ 2drop 1 ] 2keep-1up ] unit-test
129 { 10 20 30 1 } [ 10 20 30 [ 3drop 1 ] 3keep-1up ] unit-test
132 { 10 1 } [ 10 [ drop 1 ] keep-1up ] unit-test
133 { 10 20 1 } [ 10 20 [ 2drop 1 ] 2keep-1up ] unit-test
134 { 10 20 30 1 } [ 10 20 30 [ 3drop 1 ] 3keep-1up ] unit-test
136 { 10 1 2 } [ 10 [ drop 1 2 ] keep-2up ] unit-test
137 { 10 20 1 2 } [ 10 20 [ 2drop 1 2 ] 2keep-2up ] unit-test
138 { 10 20 30 1 2 } [ 10 20 30 [ 3drop 1 2 ] 3keep-2up ] unit-test
140 { 10 1 2 3 } [ 10 [ drop 1 2 3 ] keep-3up ] unit-test
141 { 10 20 1 2 3 } [ 10 20 [ 2drop 1 2 3 ] 2keep-3up ] unit-test
142 { 10 20 30 1 2 3 } [ 10 20 30 [ 3drop 1 2 3 ] 3keep-3up ] unit-test
144 : test-keep-under ( -- a b c d e ) 1 [ [ 5 + ] call 10 20 30 ] keep-under ;
145 : test-2keep-under ( -- a b c d e f g ) 1 2 [ [ 5 + ] bi@ 10 20 30 ] 2keep-under ;
146 : test-3keep-under ( -- a b c d e f g h i ) 1 2 3 [ [ 5 + ] tri@ 10 20 30 ] 3keep-under ;
147 : test-4keep-under ( -- a b c d e f g h i j k l ) 1 2 3 4 [ [ 5 + ] quad@ 10 20 30 40 ] 4keep-under ;
149 { 1 6 10 20 30 } [ test-keep-under ] unit-test
150 { 1 2 6 7 10 20 30 } [ test-2keep-under ] unit-test
151 { 1 2 3 6 7 8 10 20 30 } [ test-3keep-under ] unit-test
152 { 1 2 3 4 6 7 8 9 10 20 30 40 } [ test-4keep-under ] unit-test
154 { 1 2 3 4 1 2 3 4 5 } [ 1 2 3 4 [ 5 ] 4keep-under ] unit-test
155 { 1 2 3 4 1 2 3 4 5 6 7 8 9 10 } [ 1 2 3 4 [ 5 6 7 8 9 10 ] 4keep-under ] unit-test
159 [ 0 { 1 2 3 } [ 1 + ] 1temp1d map ] unit-test
161 { 3 { { 1 1 } { 2 2 } { 3 3 } } }
162 [ 0 { { 1 1 } { 2 2 } { 3 3 } } [ 1 + ] 1temp2d assoc-map ] unit-test
164 { 103 203 { { 1 1 } { 2 2 } { 3 3 } } }
165 [ 100 200 { { 1 1 } { 2 2 } { 3 3 } } [ [ 1 + ] bi@ ] 2temp2d assoc-map ] unit-test