]> gitweb.factorcode.org Git - factor.git/blob - basis/inverse/inverse-tests.factor
functors: inline the parts of interpolate this needs
[factor.git] / basis / inverse / inverse-tests.factor
1 ! Copyright (C) 2007, 2009 Daniel Ehrenberg.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: inverse tools.test arrays math kernel sequences
4 math.functions math.constants continuations combinators.smart ;
5 IN: inverse.tests
6
7 { 2 } [ { 3 2 } [ 3 swap 2array ] undo ] unit-test
8 [ { 3 4 } [ dup 2array ] undo ] must-fail
9
10 TUPLE: foo bar baz ;
11
12 C: <foo> foo
13
14 { 1 2 } [ 1 2 <foo> [ <foo> ] undo ] unit-test
15
16 : 2same ( x -- {x,x} ) dup 2array ;
17
18 { t } [ { 3 3 } [ 2same ] matches? ] unit-test
19 { f } [ { 3 4 } [ 2same ] matches? ] unit-test
20 [ [ 2same ] matches? ] must-fail
21
22 : something ( array -- num )
23     {
24         { [ dup 1 + 2array ] [ 3 * ] }
25         { [ 3array ] [ + + ] }
26     } switch ;
27
28 { 5 } [ { 1 2 2 } something ] unit-test
29 { 6 } [ { 2 3 } something ] unit-test
30 [ { 1 } something ] must-fail
31
32 [ 1 2 [ eq? ] undo ] must-fail
33
34 : f>c ( *fahrenheit -- *celsius )
35     32 - 1.8 / ;
36
37 { { 212.0 32.0 } } [ { 100 0 } [ [ f>c ] map ] undo ] unit-test
38 { { t t f } } [ { t f 1 } [ [ >boolean ] matches? ] map ] unit-test
39 { { t f } } [ { { 1 2 3 } 4 } [ [ >array ] matches? ] map ] unit-test
40 { 9 9 } [ 3 [ 1/2 ^ ] undo 3 [ sqrt ] undo ] unit-test
41 { 5 } [ 6 5 - [ 6 swap - ] undo ] unit-test
42 { 6 } [ 6 5 - [ 5 - ] undo ] unit-test
43
44 TUPLE: cons car cdr ;
45
46 C: <cons> cons
47
48 TUPLE: nil ;
49
50 C: <nil> nil
51
52 : list-sum ( list -- sum )
53     {
54         { [ <cons> ] [ list-sum + ] }
55         { [ <nil> ] [ 0 ] }
56         [ "Malformed list" throw ]
57     } switch ;
58
59 { 10 } [ 1 2 3 4 <nil> <cons> <cons> <cons> <cons> list-sum ] unit-test
60 { } [ <nil> [ <nil> ] undo ] unit-test
61 { 1 2 } [ 1 2 <cons> [ <cons> ] undo ] unit-test
62 { t } [ 1 2 <cons> [ <cons> ] matches? ] unit-test
63 { f } [ 1 2 <cons> [ <foo> ] matches? ] unit-test
64 { "Malformed list" } [ [ f list-sum ] [ ] recover ] unit-test
65
66 : empty-cons ( -- cons ) cons new ;
67 : cons* ( cdr car -- cons ) cons boa ;
68
69 { } [ T{ cons f f f } [ empty-cons ] undo ] unit-test
70 { 1 2 } [ 1 2 <cons> [ cons* ] undo ] unit-test
71
72 { t } [ pi [ pi ] matches? ] unit-test
73 { 0.0 } [ 0.0 pi + [ pi + ] undo ] unit-test
74 { } [ 3 [ __ ] undo ] unit-test
75
76 { 2.0 } [ 2 3 ^ [ 3 ^ ] undo ] unit-test
77 { 3.0 } [ 2 3 ^ [ 2 swap ^ ] undo ] unit-test
78
79 { { 1 } } [ { 1 2 3 } [ { 2 3 } append ] undo ] unit-test
80 { { 3 } } [ { 1 2 3 } [ { 1 2 } prepend ] undo ] unit-test
81 [ { 1 2 3 } [ { 1 2 } append ] undo ] must-fail
82 [ { 1 2 3 } [ { 2 3 } prepend ] undo ] must-fail
83
84 { [ sq ] } [ [ sqrt ] [undo] ] unit-test
85 { [ sqrt ] } [ [ sq ] [undo] ] unit-test
86 { [ not ] } [ [ not ] [undo] ] unit-test
87 { { 3 2 1 } } [ { 1 2 3 } [ reverse ] undo ] unit-test
88
89 TUPLE: funny-tuple ;
90 : <funny-tuple> ( -- funny-tuple ) \ funny-tuple boa ;
91 : funny-tuple ( -- ) "OOPS" throw ;
92
93 { } [ [ <funny-tuple> ] [undo] drop ] unit-test
94
95 { 0 } [ { 1 2 } [ [ 1 + 2 ] { } output>sequence ] undo ] unit-test
96 { { 0 1 } } [ 1 2 [ [ [ 1 + ] bi@ ] input<sequence ] undo ] unit-test