source: project/release/5/sequences/trunk/tests/run.scm @ 36461

Last change on this file since 36461 was 36461, checked in by Ivan Raikov, 23 months ago

C5 port of cis

File size: 5.3 KB
Line 
1;;;; tests.scm - tests for `sequences'
2
3
4(import (rename sequences (take s-take) (drop s-drop) (zip s-zip)
5                (partition s-partition)))
6(import test)
7(import srfi-1)
8
9
10(test-begin "sequences")
11
12(test #t (sequence? '(a b c)))
13(test #t (sequence? '#(a b c)))
14(test #t (sequence? "abc"))
15(test #f (sequence? 0))
16
17(define ras
18  (make-random-access-sequence 
19   make-list 
20   list-ref
21   length))
22
23(define ls
24  (make-linear-sequence 
25   make-list 
26   car
27   (lambda (x) 
28     (and (not (null? x)) 
29          (not (null? (cdr x)))
30          (cdr x)))))
31
32(test #t (random-access-sequence? ras))
33(test #t (random-access-sequence? '#()))
34(test #f (random-access-sequence? '()))
35
36(test #t (linear-sequence? ls))
37(test #t (linear-sequence? '()))
38(test #f (linear-sequence? ras))
39(test #f (linear-sequence? '#()))
40
41(test 0 (size ras))
42(test 3 (size '(a b c)))
43(test 3 (size '#(a b c)))
44(test 3 (size "abc"))
45(test 0 (size ls))
46
47(define r (sequence ras 98 99 100))
48
49(test 3 (size r))
50
51(define l (sequence ls 'a 'b 'c))
52
53(test 3 (size l))
54
55(test 'b (elt '(a b c) 1))
56(test 'b (elt '#(a b c) 1))
57(test #\b (elt "abc" 1))
58(test 99 (elt r 1))
59(test 'b (elt l 1))
60
61(define z
62 (s-zip
63  '(A B C) #(a b c)))
64
65(print z)
66(define it (iterator z))
67
68(print (elt z it))
69(advance! it)
70(print (elt z it))
71       
72(let ((s '(a b c)))
73  (set! (elt s 1) 'x)
74  (test 'x (elt s 1)))
75
76(set! (elt l 1) 'x)
77(test 'x (elt l 1))
78
79(let ((s '#(a b c)))
80  (set! (elt s 1) 'x)
81  (test 'x (elt s 1)))
82
83(let ((s "abc"))
84  (set! (elt s 1) #\x)
85  (test "axc" s))
86
87(test '(1 1 1) (make '() 3 1))
88(test '#(1 1 1) (make '#() 3 1))
89(test "   " (make "" 3 #\space))
90(test "aaa" (make "" 3 #\a))
91
92(test '(c b a) (rev '(a b c)))
93(test '#(c b a) (rev '#(a b c)))
94(test "cba" (rev "abc"))
95
96(let ((r2 (rev r)))
97  (do ((i 0 (add1 i)))
98      ((>= i (size r2)))
99    (test (+ i 98) (elt r2 (- (size r2) i 1)))))
100
101(let ((l2 (rev l)))
102  (do ((i 0 (add1 i))
103       (vs '(a x c) (cdr vs)))
104      ((>= i 3))
105    (test #t (eq? (car vs) (elt l2 i)))))
106
107(test '(b) (sub '(a b c d) 1 2))
108(test '(b c d) (sub '(a b c d) 1))
109(test '#(b) (sub '#(a b c d) 1 2))
110(test '#(b c d) (sub '#(a b c d) 1))
111(test "b" (sub "abcd" 1 2))
112(test "bcd" (sub "abcd" 1))
113
114(let ((s '(a b c d)))
115  (set! (sub s 1 3) '(x y))
116  (test #t (equal? '(a x y d) s)))
117
118(let ((s '#(a b c d)))
119  (set! (sub s 1 3) '#(x y))
120  (test #t (equal? '#(a x y d) s)))
121
122(let ((s "abcd"))
123  (set! (sub s 1 3) "xy")
124  (test #t (equal? "axyd" s)))
125
126(set! (sub r 1) (sequence ras 'x 'y))
127(test 98 (elt r 0))
128(test 'x (elt r 1))
129(test 'y (elt r 2))
130
131(test '(((() a) b) c) (foldl list '() '(a b c)))
132(test '(a (b (c ()))) (foldr list '() '(a b c)))
133(test '(((() a) b) c) (foldl list '() '#(a b c)))
134(test '(a (b (c ()))) (foldr list '() '#(a b c)))
135(test '(((() #\a) #\b) #\c) (foldl list '() "abc"))
136(test '(#\a (#\b (#\c ()))) (foldr list '() "abc"))
137
138(set! r (sequence ras 'a 'b 'c))
139(test '(((() a) b) c) (foldl list '() r))
140(test '(a (b (c ()))) (foldr list '() r))
141(test '(a (x (c ()))) (foldr list '() l))
142
143(let ((i 0))
144  (for (lambda (x) 
145         (test i x)
146         (set! i (add1 i)))
147       '(0 1 2 3 4 5)))
148
149(let ((i 1))
150  (for (lambda (x) 
151         (test i x)
152         (set! i (add1 i)))
153       (sequence l 1 2 3)))
154
155(test '(2 4 6) (smap '() (cut * <> 2) '(1 2 3)))
156(test '#(2 4 6) (smap '#() (cut * <> 2) '(1 2 3)))
157(test "ABC" (smap "" char-upcase "abc"))
158(test '((a) (b) (c)) (smap '() list r))
159(test '#((a) (b) (c)) (smap '#() list r))
160
161;;XXX tests for smap on linear-sequence
162
163(let ((i 0))
164  (for* (lambda (s it)
165          (test #t (equal? (elt s it) (elt s i)))
166          (test #f (at-end? it))
167          (set! i (add1 i)))
168        '#(1 2 3)))
169
170(define it (iterator r))
171(advance! it 3)
172(test #t (at-end? it))
173
174(test "abc" (smap* "" (lambda (s it) (char-downcase (elt s it))) '#(#\A #\B #\C)))
175
176(define x "abc")
177(set! (elt x (iterator x 1)) #\x)
178(test "axc" x)
179
180(test #f (pos odd? '(2 4 6)))
181(test 2 (pos odd? '#(0 2 3 5)))
182(test '(1 2) (s-take positive? '(1 2 -3 4)))
183(test '(-3 1) (s-drop positive? '(5 2 -3 1)))
184(test '((4 5) (-1 2)) (receive (split positive? '(4 5 -1 2))))
185
186(test '(#(1 3) #(2 4)) (receive (s-partition odd? '#(1 2 3 4))))
187
188(test '(a b c) (coerce '() (fill! (lambda (_ it) (index it)) r)))
189
190(test #t ((is? '(33)) '(33)))
191(test #f ((is? 1) 2))
192
193
194;;; by Thomas Chust:
195
196(let* ((s '(a b c))
197       (it (iterator s)))
198  (test #t (linear-iterator? it))
199  (test #t (linear-sequence? s))
200  (test 'a (elt s it))
201  (advance! it)
202  (test 'b (elt s it)))
203
204(test #t (at-end? (iterator '())))
205(test #f (at-end? (iterator '(1))))
206(test #t (at-end? (iterator '#())))
207
208
209;;; port-sequences
210
211(define str "abcdef")
212
213(let ((i 0))
214  (for (lambda (x)
215         (assert (eq? (string-ref str i) x))
216         (set! i (add1 i)))
217       (port->sequence (open-input-string str))))
218
219
220;;; comprehensions
221
222(import sequence-comprehensions srfi-42)
223
224(let ((i 1))
225  (do-ec (:seq j '(1 2 3))
226         (begin
227           (test #t (= i j))
228           (set! i (add1 i)))))
229
230(test '(#\a #\b #\c) (list-ec (:seq x "aBbCDEc") (if (char-lower-case? x)) x))
231
232(test 3 (peek '#(3)))
233(test '(5 6) (pop '(4 5 6)))
234(test "bc" (pop "abc"))
235(test #t (all? odd? '(1 3 5)))
236(test #f (all? char-whitespace? " \t1"))
237(test #t (thereis? odd? '(2 4 1)))
238(test #f (thereis? even? (sequence ras 1 3 5)))
239(test '(1 3) (intersection '() = '(1 2 3) '#(1 3 5)))
240(test #t (lset= = '(4 3 1 2) (vector->list (union '#() = '(1 2) '(3 4)))))
241(test '#(3 4) (difference '#() = '#(3 4 5) '#(5)))
242
243(test-end)
244
245(test-exit)
Note: See TracBrowser for help on using the repository browser.