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

Last change on this file since 37952 was 37952, checked in by felix winkelmann, 9 months ago

sequences 0.6.1: drop debris from previous experiments

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