srfi-214

  1(import (scheme base)
  2        (scheme write)
  3        (scheme process-context)
  4        (srfi 214)
  5        (srfi 64))
  6
  7(test-begin "Flexvectors")
  8
  9(test-equal "flexvector?" #t (flexvector? (flexvector)))
 10(test-equal "flexvector-length" 3 (flexvector-length (make-flexvector 3 #f)))
 11(test-equal "flexvector" 3 (flexvector-length (flexvector 1 2 3)))
 12
 13(let ((fv (flexvector 'a 'b 'c)))
 14  (test-equal "flexvector-ref" 'b (flexvector-ref fv 1))
 15  (test-equal "flexvector-front" 'a (flexvector-front fv))
 16  (test-equal "flexvector-back" 'c (flexvector-back fv))
 17  (test-equal "flexvector-set! return" 'b (flexvector-set! fv 1 'd))
 18  (test-equal "flexvector-set! mutate" 'd (flexvector-ref fv 1))
 19  (test-equal "flexvector-add-back! return" fv (flexvector-add-back! fv 'e))
 20  (test-equal "flexvector-add-back! mutate" '(4 . e)
 21    (cons (flexvector-length fv)
 22          (flexvector-ref fv (- (flexvector-length fv) 1))))
 23  (test-equal "flexvector-remove! return" 'd (flexvector-remove! fv 1))
 24  (test-equal "flexvector-remove! mutate" '(3 . c)
 25    (cons (flexvector-length fv)
 26          (flexvector-ref fv 1)))
 27  (test-equal "flexvector-clear! return" fv (flexvector-clear! fv))
 28  (test-equal "flexvector-clear! mutate" 0 (flexvector-length fv))
 29  (test-equal "flexvector-empty?" #t (flexvector-empty? fv)))
 30
 31(test-equal "flexvector=? same symbols" #t
 32  (flexvector=? eq? (flexvector 'a 'b) (flexvector 'a 'b)))
 33(test-equal "flexvector=? different symbols" #f
 34  (flexvector=? eq? (flexvector 'a 'b) (flexvector 'b 'a)))
 35(test-equal "flexvector=? different lengths" #f
 36  (flexvector=? = (flexvector 1 2 3 4 5) (flexvector 1 2 3 4)))
 37(test-equal "flexvector=? same numbers" #t
 38  (flexvector=? = (flexvector 1 2 3 4) (flexvector 1 2 3 4)))
 39(test-equal "flexvector=? 0 arguments" #t
 40  (flexvector=? eq?))
 41(test-equal "flexvector=? 1 argument" #t
 42  (flexvector=? eq? (flexvector 'a)))
 43
 44(test-equal "make-flexvector" #(a a a) (flexvector->vector (make-flexvector 3 'a)))
 45
 46(test-equal "flexvector-unfold"
 47  #(1 4 9 16 25 36 49 64 81 100)
 48  (flexvector->vector
 49    (flexvector-unfold (lambda (x) (> x 10))
 50                       (lambda (x) (* x x))
 51                       (lambda (x) (+ x 1))
 52                       1)))
 53(test-equal "flexvector-unfold-right"
 54  #(100 81 64 49 36 25 16 9 4 1)
 55  (flexvector->vector
 56    (flexvector-unfold-right (lambda (x) (> x 10))
 57                             (lambda (x) (* x x))
 58                             (lambda (x) (+ x 1))
 59                             1)))
 60
 61
 62(test-equal "string->flexvector" #(#\a #\b #\c)
 63  (flexvector->vector (string->flexvector "abc")))
 64(test-equal "flexvector->string" "abc" (flexvector->string (flexvector #\a #\b #\c)))
 65
 66(define genlist '(a b c))
 67(define (mock-generator)
 68  (if (pair? genlist)
 69    (let ((value (car genlist)))
 70      (set! genlist (cdr genlist))
 71      value)
 72    (eof-object)))
 73
 74(test-equal "generator->flexvector" #(a b c)
 75  (flexvector->vector (generator->flexvector mock-generator)))
 76(test-equal "flexvector->generator" '(a b c #t)
 77  (let* ((gen (flexvector->generator (flexvector 'a 'b 'c)))
 78         (one (gen))
 79         (two (gen))
 80         (three (gen))
 81         (four (eof-object? (gen))))
 82    (list one two three four)))
 83
 84; Nondestructive operations on one vector
 85(let ((fv (flexvector 10 20 30)))
 86  (test-equal "flexvector->vector" #(10 20 30) (flexvector->vector fv))
 87  (test-equal "flexvector->list" '(10 20 30) (flexvector->list fv))
 88  (test-equal "flexvector->list sublist" '(10 20) (flexvector->list fv 0 2))
 89  (test-equal "flexvector->list omitted end" '(20 30) (flexvector->list fv 1))
 90  (test-equal "flexvector->list same index" '() (flexvector->list fv 1 1))
 91  (test-equal "reverse-flexvector->list" '(30 20 10) (reverse-flexvector->list fv))
 92  (test-equal "flexvector-copy" #t
 93    (let ((copy (flexvector-copy fv)))
 94      (and (= (flexvector-length fv) (flexvector-length copy))
 95           (not (eq? fv copy)))))
 96  (test-equal "flexvector-reverse-copy" #(30 20 10)
 97    (flexvector->vector (flexvector-reverse-copy fv)))
 98  (test-equal "flexvector-copy start" #(20 30)
 99    (flexvector->vector (flexvector-copy fv 1)))
100  (test-equal "flexvector-copy start end" #(20)
101    (flexvector->vector (flexvector-copy fv 1 2)))
102  (test-equal "flexvector-for-each" '(30 20 10)
103    (let ((res '()))
104      (flexvector-for-each (lambda (x) (set! res (cons x res))) fv)
105      res))
106  (test-equal "flexvector-for-each/index" '(34 22 10)
107    (let ((res '()))
108      (flexvector-for-each/index
109        (lambda (i x) (set! res (cons (+ x (* i 2)) res)))
110        fv)
111      res))
112  (test-equal "flexvector-map" #(100 200 300)
113    (flexvector->vector (flexvector-map (lambda (x) (* x 10)) fv)))
114  (test-equal "flexvector-map/index" #(10 22 34)
115    (flexvector->vector (flexvector-map/index (lambda (i x) (+ x (* i 2))) fv)))
116  (test-equal "flexvector-append-map" #(10 100 20 200 30 300)
117    (flexvector->vector
118      (flexvector-append-map (lambda (x) (flexvector x (* x 10))) fv)))
119  (test-equal "flexvector-append-map/index" #(0 10 10 1 20 22 2 30 34)
120    (flexvector->vector
121      (flexvector-append-map/index
122        (lambda (i x) (flexvector i x (+ x (* i 2))))
123        fv)))
124  (test-equal "flexvector-filter" #(10)
125    (flexvector->vector (flexvector-filter (lambda (x) (< x 15)) fv)))
126  (test-equal "flexvector-filter/index" #(10 30)
127    (flexvector->vector (flexvector-filter/index (lambda (i x) (not (= i 1))) fv)))
128  (test-equal "flexvector-fold" '(30 20 10)
129    (flexvector-fold (lambda (x y) (cons y x)) '() fv))
130  (test-equal "flexvector-fold-right" '(10 20 30)
131    (flexvector-fold-right (lambda (x y) (cons y x)) '() fv))
132  (test-equal "flexvector-count" 2
133    (flexvector-count (lambda (x) (< x 25)) fv))
134  (test-equal "flexvector-cumulate" #(3 4 8 9 14 23 25 30 36)
135    (flexvector->vector
136      (flexvector-cumulate + 0 (flexvector 3 1 4 1 5 9 2 5 6))))
137  (test-equal "flexvector-any" '(#t . #f)
138    (cons (flexvector-any (lambda (x) (= x 20)) fv)
139          (flexvector-any (lambda (x) (= x 21)) fv)))
140  (test-equal "flexvector-every" '(#t . #f)
141    (cons (flexvector-every (lambda (x) (< x 40)) fv)
142          (flexvector-every (lambda (x) (< x 30)) fv)))
143  (test-equal "flexvector-index" 1
144    (flexvector-index (lambda (x) (> x 10)) fv))
145  (test-equal "flexvector-index-right" 2
146    (flexvector-index-right (lambda (x) (> x 10)) fv))
147  (test-equal "flexvector-skip" 1
148    (flexvector-skip (lambda (x) (< x 20)) fv))
149  (test-equal "flexvector-skip-right" 0
150    (flexvector-skip-right (lambda (x) (> x 10)) fv))
151  (test-equal "flexvector-partition" '(#(10 20) #(30))
152    (call-with-values
153      (lambda () (flexvector-partition (lambda (x) (< x 25)) fv))
154      (lambda vs (map flexvector->vector vs)))))
155
156(let ((fv (flexvector #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j))
157      (cmp (lambda (char1 char2)
158             (cond ((char<? char1 char2) -1)
159                   ((char=? char1 char2) 0)
160                   (else 1)))))
161  (test-equal "flexvector-binary-search" 3
162    (flexvector-binary-search fv #\d cmp))
163  (test-equal "flexvector-binary-search first" 0
164    (flexvector-binary-search fv #\a cmp))
165  (test-equal "flexvector-binary-search last" 9
166    (flexvector-binary-search fv #\j cmp))
167  (test-equal "flexvector-binary-search not found" #f
168    (flexvector-binary-search fv #\k cmp))
169
170  (test-equal "flexvector-binary-search in range" 5
171    (flexvector-binary-search fv #\f cmp 2 6))
172  (test-equal "flexvector-binary-search out of range" #f
173    (flexvector-binary-search fv #\f cmp 1 5)))
174
175; Nondestructive operations on multiple vectors
176(test-equal "flexvector-append" #(10 20 30 40 50 60)
177  (flexvector->vector
178    (flexvector-append (flexvector 10 20)
179                       (flexvector)
180                       (flexvector 30 40)
181                       (flexvector 50 60))))
182(test-equal "flexvector-concatenate" #(10 20 30 40 50 60)
183  (flexvector->vector
184    (flexvector-concatenate
185      (list (flexvector 10 20)
186            (flexvector)
187            (flexvector 30 40)
188            (flexvector 50 60)))))
189(test-equal "flexvector-append-subvectors" #(a b h i)
190  (flexvector->vector
191    (flexvector-append-subvectors
192      (flexvector 'a 'b 'c 'd 'e) 0 2
193      (flexvector 'f 'g 'h 'i 'j) 2 4)))
194
195
196; Destructive operations on one vector
197(define-syntax mutate-as
198  (syntax-rules ()
199    ((_ name vec expr)
200      (let ((name (vector->flexvector vec)))
201        expr
202        (flexvector->vector name)))))
203
204(test-equal "flexvector-add! empty" '#(foo)
205  (mutate-as x '#() (flexvector-add! x 0 'foo)))
206(test-equal "flexvector-add! empty multiple" '#(foo bar baz)
207  (mutate-as x '#() (flexvector-add! x 0 'foo 'bar 'baz)))
208(test-equal "flexvector-add! start" '#(foo bar baz)
209  (mutate-as x '#(bar baz) (flexvector-add! x 0 'foo)))
210(test-equal "flexvector-add! start multiple" '#(foo bar baz qux quux)
211  (mutate-as x '#(qux quux) (flexvector-add! x 0 'foo 'bar 'baz)))
212(test-equal "flexvector-add! middle" '#(foo bar baz)
213  (mutate-as x '#(foo baz) (flexvector-add! x 1 'bar)))
214(test-equal "flexvector-add! middle multiple" '#(foo bar baz qux quux)
215  (mutate-as x '#(foo quux) (flexvector-add! x 1 'bar 'baz 'qux)))
216(test-equal "flexvector-add! end" '#(foo bar baz)
217  (mutate-as x '#(foo bar) (flexvector-add! x 2 'baz)))
218(test-equal "flexvector-add! end multiple" '#(foo bar baz qux quux)
219  (mutate-as x '#(foo bar) (flexvector-add! x 2 'baz 'qux 'quux)))
220
221(test-equal "flexvector-add-all!" '#(foo bar baz qux)
222  (mutate-as x '#(foo qux) (flexvector-add-all! x 1 '(bar baz))))
223
224(test-equal "flexvector-add-front! empty" '#(foo)
225  (mutate-as x '#() (flexvector-add-front! x 'foo)))
226(test-equal "flexvector-add-front! empty multiple" '#(foo bar baz)
227  (mutate-as x '#() (flexvector-add-front! x 'foo 'bar 'baz)))
228(test-equal "flexvector-add-front!" '#(foo bar baz)
229  (mutate-as x '#(bar baz) (flexvector-add-front! x 'foo)))
230(test-equal "flexvector-add-front! multiple" '#(foo bar baz qux quux)
231  (mutate-as x '#(qux quux) (flexvector-add-front! x 'foo 'bar 'baz)))
232
233(test-equal "flexvector-add-back! empty" '#(foo)
234  (mutate-as x '#() (flexvector-add-back! x 'foo)))
235(test-equal "flexvector-add-back! empty multiple" '#(foo bar baz)
236  (mutate-as x '#() (flexvector-add-back! x 'foo 'bar 'baz)))
237(test-equal "flexvector-add-back!" '#(foo bar baz)
238  (mutate-as x '#(foo bar) (flexvector-add-back! x 'baz)))
239(test-equal "flexvector-add-back! multiple" '#(foo bar baz qux quux)
240  (mutate-as x '#(foo bar) (flexvector-add-back! x 'baz 'qux 'quux)))
241
242(test-equal "flexvector-append!" '#(foo bar baz qux)
243  (mutate-as x '#(foo bar) (flexvector-append! x (flexvector 'baz 'qux))))
244(test-equal "flexvector-append! multiple" '#(foo bar baz qux quux)
245  (mutate-as x '#(foo bar) (flexvector-append! x (flexvector 'baz 'qux) (flexvector 'quux))))
246
247(test-equal "flexvector-remove!" '#(foo baz)
248  (mutate-as x '#(foo bar baz) (flexvector-remove! x 1)))
249(test-equal "flexvector-remove! only" '#()
250  (mutate-as x '#(foo) (flexvector-remove! x 0)))
251
252(test-equal "flexvector-remove-front!" '#(bar baz)
253  (mutate-as x '#(foo bar baz) (flexvector-remove-front! x)))
254(test-equal "flexvector-remove-front! only" '#()
255  (mutate-as x '#(foo) (flexvector-remove-front! x)))
256
257(test-equal "flexvector-remove-back!" '#(foo bar)
258  (mutate-as x '#(foo bar baz) (flexvector-remove-back! x)))
259(test-equal "flexvector-remove-back! only" '#()
260  (mutate-as x '#(foo) (flexvector-remove-back! x)))
261
262(test-equal "flexvector-remove-range!" '#(a e f)
263  (mutate-as x '#(a b c d e f) (flexvector-remove-range! x 1 4)))
264(test-equal "flexvector-remove-range! empty range" '#(a b c d e f)
265  (mutate-as x '#(a b c d e f) (flexvector-remove-range! x 1 1)))
266(test-equal "flexvector-remove-range! overflow left" '#(e f)
267  (mutate-as x '#(a b c d e f) (flexvector-remove-range! x -1 4)))
268(test-equal "flexvector-remove-range! overflow right" '#(a b)
269  (mutate-as x '#(a b c d e f) (flexvector-remove-range! x 2 10)))
270
271(test-equal "flexvector-map!" '#(100 200 300)
272  (mutate-as fv '#(10 20 30) (flexvector-map! (lambda (x) (* x 10)) fv)))
273(test-equal "flexvector-map/index!" '#(10 22 34)
274  (mutate-as fv '#(10 20 30) (flexvector-map/index! (lambda (i x) (+ x (* i 2))) fv)))
275(test-equal "flexvector-filter!" '#(10)
276  (mutate-as fv '#(10 20 30) (flexvector-filter! (lambda (x) (< x 15)) fv)))
277(test-equal "flexvector-filter/index!" '#(10 30)
278  (mutate-as fv '#(10 20 30) (flexvector-filter/index! (lambda (i x) (not (= i 1))) fv)))
279
280(test-equal "flexvector-swap!" #(10 30 20)
281  (mutate-as fv '#(10 20 30) (flexvector-swap! fv 1 2)))
282(test-equal "flexvector-reverse!" #(30 20 10)
283  (mutate-as fv '#(10 20 30) (flexvector-reverse! fv)))
284
285(test-equal "flexvector-copy!" #(1 20 30 40 5)
286  (mutate-as fv '#(1 2 3 4 5) (flexvector-copy! fv 1 (flexvector 20 30 40))))
287(test-equal "flexvector-copy! bounded" #(1 20 30 40 5)
288  (mutate-as fv '#(1 2 3 4 5) (flexvector-copy! fv 1 (flexvector 10 20 30 40 50) 1 4)))
289(test-equal "flexvector-copy! overflow" #(1 2 30 40 50)
290  (mutate-as fv '#(1 2 3) (flexvector-copy! fv 2 (flexvector 30 40 50))))
291(test-equal "flexvector-reverse-copy!" #(1 40 30 20 5)
292  (mutate-as fv '#(1 2 3 4 5) (flexvector-reverse-copy! fv 1 (flexvector 20 30 40))))
293(test-equal "flexvector-reverse-copy! bounded" #(1 40 30 20 5)
294  (mutate-as fv '#(1 2 3 4 5) (flexvector-reverse-copy! fv 1 (flexvector 10 20 30 40 50) 1 4)))
295(test-equal "flexvector-reverse-copy! overflow" #(1 2 50 40 30)
296  (mutate-as fv '#(1 2 3) (flexvector-reverse-copy! fv 2 (flexvector 30 40 50))))
297
298(test-equal "flexvector-fill!" '#(foo foo foo)
299  (mutate-as x '#(1 2 3) (flexvector-fill! x 'foo)))
300(test-equal "flexvector-fill! start" '#(1 2 bar bar bar)
301  (mutate-as x '#(1 2 3 4 5) (flexvector-fill! x 'bar 2)))
302(test-equal "flexvector-fill! start end" '#(1 2 baz baz 5)
303  (mutate-as x '#(1 2 3 4 5) (flexvector-fill! x 'baz 2 4)))
304(test-equal "flexvector-fill! clamped" '#(qux qux qux)
305  (mutate-as x '#(1 2 3) (flexvector-fill! x 'qux -1 10)))
306
307(test-end "Flexvectors")