source: project/release/4/fast-loop/trunk/test.scm @ 14588

Last change on this file since 14588 was 14588, checked in by Alex Shinn, 11 years ago

adding patch from zbigniew for up-from & down-from
with steps but no limit, and fixed reverse while/until
tests.

File size: 3.7 KB
Line 
1
2(require-extension fast-loop test)
3
4(test-begin)
5
6(test
7 "stepping"
8 '(0 1 2)
9 (loop lp ((with i 0 (+ i 1))
10           (with res '() (cons i res)))
11   (if (= i 3)
12     (reverse res)
13     (lp))))
14
15(test
16 "basic in-list"
17 '(c b a)
18 (let ((res '()))
19   (loop ((for x (in-list '(a b c))))
20     (set! res (cons x res)))
21   res))
22
23(test
24 "in-list with result"
25 '(c b a)
26 (loop ((for x (in-list '(a b c)))
27        (with res '() (cons x res)))
28   => res))
29
30(test
31 "in-list with listing"
32 '(a b c)
33 (loop ((for x (in-list '(a b c))) (for res (listing x))) => res))
34
35(test
36 "in-list with listing-reverse"
37 '(c b a)
38 (loop ((for x (in-list '(a b c))) (for res (listing-reverse x))) => res))
39
40(test
41 "uneven length in-list's"
42 '((a . 1) (b . 2) (c . 3))
43 (loop ((for x (in-list '(a b c)))
44        (for y (in-list '(1 2 3 4)))
45        (for res (listing (cons x y))))
46    => res))
47
48(test
49 "in-lists"
50 '((a 1) (b 2) (c 3))
51 (loop ((for ls (in-lists '((a b c) (1 2 3))))
52        (for res (listing ls)))
53   => res))
54
55(define (flatten ls)
56  (reverse
57   (loop lp ((for x ls (in-list ls)) (with res '()))
58     => res
59     (if (pair? x)
60         (lp (=> res (lp (=> ls x))))
61         (lp (=> res (cons x res)))))))
62
63(test
64 "flatten (recursion test)"
65 '(1 2 3 4 5 6 7)
66 (flatten '(1 (2) (3 (4 (5)) 6) 7)))
67
68(test
69 "in-string"
70 '(#\h #\e #\l #\l #\o)
71 (loop ((for c (in-string "hello")) (for res (listing c))) => res))
72
73(test
74 "in-string with start"
75 '(#\l #\o)
76 (loop ((for c (in-string "hello" 3)) (for res (listing c))) => res))
77
78(test
79 "in-string with start and end"
80 '(#\h #\e #\l #\l)
81 (loop ((for c (in-string "hello" 0 4)) (for res (listing c))) => res))
82
83(test
84 "in-string with start, end and step"
85 '(#\e #\l)
86 (loop ((for c (in-string "hello" 1 4 2)) (for res (listing c))) => res))
87
88(test
89 "in-string-reverse"
90 '(#\o #\l #\l #\e #\h)
91 (loop ((for c (in-string-reverse "hello")) (for res (listing c))) => res))
92
93(test
94 "in-vector"
95 '(1 2 3)
96 (loop ((for x (in-vector '#(1 2 3))) (for res (listing x))) => res))
97
98(test "up-from" '(5 6 7)
99  (loop ((for i (up-from 5 (to 8)))
100         (for res (listing i)))
101    => res))
102
103(test "up-from by" '(5 10 15)
104  (loop ((for i (up-from 5 (to 20) (by 5)))
105         (for res (listing i)))
106    => res))
107
108(test "up-from listing if" '(10 12 14 16 18)
109  (loop ((for i (up-from 10 (to 20)))
110         (for res (listing i (if (even? i)))))
111    => res))
112
113(test "down-from" '(7 6 5)
114  (loop ((for i (down-from 8 (to 5)))
115         (for res (listing i)))
116    => res))
117
118(test "down-from by" '(15 10 5)
119  (loop ((for i (down-from 20 (to 5) (by 5)))
120         (for res (listing i)))
121    => res))
122
123(test "down-from listing if" '(18 16 14 12 10)
124  (loop ((for i (down-from 20 (to 10)))
125         (for res (listing i (if (even? i)))))
126    => res))
127
128(test "appending" '(1 2 3 4 5 6 7 8 9)
129  (loop ((for ls (in-list '((1 2 3) (4 5 6) (7 8 9))))
130         (for res (appending ls)))
131    => res))
132
133(test "appending-reverse" '(9 8 7 6 5 4 3 2 1)
134  (loop ((for ls (in-list '((1 2 3) (4 5 6) (7 8 9))))
135         (for res (appending-reverse ls)))
136    => res))
137
138(test "while + up-from" '(5 6 7)
139      (loop ((for i (up-from 5 (to 10)))
140             (while (< i 8))
141             (for res (listing i)))
142        => res))
143
144(test "up-from by, open-ended" '(5 7 9)
145  (loop ((for i (up-from 5 (by 2)))
146         (while (< i 10))
147         (for res (listing i)))
148    => res))
149
150(test "up-from open-ended" '(5 6 7)
151  (loop ((for i (up-from 5))
152         (while (< i 8))
153         (for res (listing i)))
154    => res))
155
156(test "down-from by, open-ended" '(5 3 1)
157  (loop ((for i (down-from 7 (by 2)))
158         (until (< i 1))
159         (for res (listing i)))
160    => res))
161
162(test "down-from open-ended" '(4 3 2)
163  (loop ((for i (down-from 5))
164         (until (< i 2))
165         (for res (listing i)))
166    => res))
167
168(test-end)
169
Note: See TracBrowser for help on using the repository browser.