]> gitweb.factorcode.org Git - factor.git/blob - basis/stack-checker/transforms/transforms-tests.factor
8ae30dcd97eff5a074cc6260542c9c9993c9c619
[factor.git] / basis / stack-checker / transforms / transforms-tests.factor
1 IN: stack-checker.transforms.tests
2 USING: sequences stack-checker.transforms tools.test math kernel
3 quotations stack-checker accessors combinators words arrays
4 classes classes.tuple ;
5
6 : compose-n-quot ( word -- quot' ) <repetition> >quotation ;
7 : compose-n ( quot -- ) compose-n-quot call ;
8 \ compose-n [ compose-n-quot ] 2 define-transform
9 : compose-n-test ( a b c -- x ) 2 \ + compose-n ;
10
11 [ 6 ] [ 1 2 3 compose-n-test ] unit-test
12
13 TUPLE: color r g b ;
14
15 C: <color> color
16
17 : cleave-test ( color -- r g b )
18     { [ r>> ] [ g>> ] [ b>> ] } cleave ;
19
20 { 1 3 } [ cleave-test ] must-infer-as
21
22 [ 1 2 3 ] [ 1 2 3 <color> cleave-test ] unit-test
23
24 [ 1 2 3 ] [ 1 2 3 <color> \ cleave-test def>> call ] unit-test
25
26 : 2cleave-test ( a b -- c d e ) { [ 2array ] [ + ] [ - ] } 2cleave ;
27
28 [ { 1 2 } 3 -1 ] [ 1 2 2cleave-test ] unit-test
29
30 [ { 1 2 } 3 -1 ] [ 1 2 \ 2cleave-test def>> call ] unit-test
31
32 : spread-test ( a b c -- d e f ) { [ sq ] [ neg ] [ recip ] } spread ;
33
34 [ 16 -3 1/6 ] [ 4 3 6 spread-test ] unit-test
35
36 [ 16 -3 1/6 ] [ 4 3 6 \ spread-test def>> call ] unit-test
37
38 [ fixnum instance? ] must-infer
39
40 : bad-new-test ( -- obj ) V{ } new ;
41
42 [ bad-new-test ] must-infer
43
44 [ bad-new-test ] must-fail