(find, find-tail, lset-union): New tests.
[bpt/guile.git] / test-suite / tests / srfi-1.test
1 ;;;; srfi-1.test --- Test suite for Guile's SRFI-1 functions. -*- scheme -*-
2 ;;;;
3 ;;;; Copyright 2003, 2004, 2005 Free Software Foundation, Inc.
4 ;;;;
5 ;;;; This program is free software; you can redistribute it and/or modify
6 ;;;; it under the terms of the GNU General Public License as published by
7 ;;;; the Free Software Foundation; either version 2, or (at your option)
8 ;;;; any later version.
9 ;;;;
10 ;;;; This program is distributed in the hope that it will be useful,
11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 ;;;; GNU General Public License for more details.
14 ;;;;
15 ;;;; You should have received a copy of the GNU General Public License
16 ;;;; along with this software; see the file COPYING. If not, write to
17 ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
18 ;;;; Boston, MA 02111-1307 USA
19
20 (use-modules (srfi srfi-1)
21 (test-suite lib))
22
23 (define (ref-delete x lst . proc)
24 "Reference implemenation of srfi-1 `delete'."
25 (set! proc (if (null? proc) equal? (car proc)))
26 (do ((ret '())
27 (lst lst (cdr lst)))
28 ((null? lst)
29 (reverse! ret))
30 (if (not (proc x (car lst)))
31 (set! ret (cons (car lst) ret)))))
32
33 (define (ref-delete-duplicates lst . proc)
34 "Reference implemenation of srfi-1 `delete-duplicates'."
35 (set! proc (if (null? proc) equal? (car proc)))
36 (if (null? lst)
37 '()
38 (do ((keep '()))
39 ((null? lst)
40 (reverse! keep))
41 (let ((elem (car lst)))
42 (set! keep (cons elem keep))
43 (set! lst (ref-delete elem lst proc))))))
44
45
46 ;;
47 ;; alist-copy
48 ;;
49
50 (with-test-prefix "alist-copy"
51
52 ;; return a list which is the pairs making up alist A, the spine and cells
53 (define (alist-pairs a)
54 (let more ((a a)
55 (result a))
56 (if (pair? a)
57 (more (cdr a) (cons a result))
58 result)))
59
60 ;; return a list of the elements common to lists X and Y, compared with eq?
61 (define (common-elements x y)
62 (if (null? x)
63 '()
64 (if (memq (car x) y)
65 (cons (car x) (common-elements (cdr x) y))
66 (common-elements (cdr x) y))))
67
68 ;; validate an alist-copy of OLD to NEW
69 ;; lists must be equal, and must comprise new pairs
70 (define (valid-alist-copy? old new)
71 (and (equal? old new)
72 (null? (common-elements old new))))
73
74 (pass-if-exception "too few args" exception:wrong-num-args
75 (alist-copy))
76
77 (pass-if-exception "too many args" exception:wrong-num-args
78 (alist-copy '() '()))
79
80 (let ((old '()))
81 (pass-if old (valid-alist-copy? old (alist-copy old))))
82
83 (let ((old '((1 . 2))))
84 (pass-if old (valid-alist-copy? old (alist-copy old))))
85
86 (let ((old '((1 . 2) (3 . 4))))
87 (pass-if old (valid-alist-copy? old (alist-copy old))))
88
89 (let ((old '((1 . 2) (3 . 4) (5 . 6))))
90 (pass-if old (valid-alist-copy? old (alist-copy old)))))
91
92 ;;
93 ;; alist-delete
94 ;;
95
96 (with-test-prefix "alist-delete"
97
98 (pass-if "equality call arg order"
99 (let ((good #f))
100 (alist-delete 'k '((ak . 123))
101 (lambda (k ak)
102 (if (and (eq? k 'k) (eq? ak 'ak))
103 (set! good #t))))
104 good))
105
106 (pass-if "delete keys greater than 5"
107 (equal? '((4 . x) (5 . y))
108 (alist-delete 5 '((4 . x) (5 . y) (6 . z)) <)))
109
110 (pass-if "empty"
111 (equal? '() (alist-delete 'x '())))
112
113 (pass-if "(y)"
114 (equal? '() (alist-delete 'y '((y . 1)))))
115
116 (pass-if "(n)"
117 (equal? '((n . 1)) (alist-delete 'y '((n . 1)))))
118
119 (pass-if "(y y)"
120 (equal? '() (alist-delete 'y '((y . 1) (y . 2)))))
121
122 (pass-if "(n y)"
123 (equal? '((n . 1)) (alist-delete 'y '((n . 1) (y . 2)))))
124
125 (pass-if "(y n)"
126 (equal? '((n . 2)) (alist-delete 'y '((y . 1) (n . 2)))))
127
128 (pass-if "(n n)"
129 (equal? '((n . 1) (n . 2)) (alist-delete 'y '((n . 1) (n . 2)))))
130
131 (pass-if "(y y y)"
132 (equal? '() (alist-delete 'y '((y . 1) (y . 2) (y . 3)))))
133
134 (pass-if "(n y y)"
135 (equal? '((n . 1)) (alist-delete 'y '((n . 1) (y . 2) (y . 3)))))
136
137 (pass-if "(y n y)"
138 (equal? '((n . 2)) (alist-delete 'y '((y . 1) (n . 2) (y . 3)))))
139
140 (pass-if "(n n y)"
141 (equal? '((n . 1) (n . 2)) (alist-delete 'y '((n . 1) (n . 2) (y . 3)))))
142
143 (pass-if "(y y n)"
144 (equal? '( (n . 3)) (alist-delete 'y '((y . 1) (y . 2) (n . 3)))))
145
146 (pass-if "(n y n)"
147 (equal? '((n . 1) (n . 3)) (alist-delete 'y '((n . 1) (y . 2) (n . 3)))))
148
149 (pass-if "(y n n)"
150 (equal? '((n . 2) (n . 3)) (alist-delete 'y '((y . 1) (n . 2) (n . 3)))))
151
152 (pass-if "(n n n)"
153 (equal? '((n . 1) (n . 2) (n . 3)) (alist-delete 'y '((n . 1) (n . 2) (n . 3))))))
154
155 ;;
156 ;; append-map
157 ;;
158
159 (with-test-prefix "append-map"
160
161 (with-test-prefix "one list"
162
163 (pass-if "()"
164 (equal? '() (append-map noop '(()))))
165
166 (pass-if "(1)"
167 (equal? '(1) (append-map noop '((1)))))
168
169 (pass-if "(1 2)"
170 (equal? '(1 2) (append-map noop '((1 2)))))
171
172 (pass-if "() ()"
173 (equal? '() (append-map noop '(() ()))))
174
175 (pass-if "() (1)"
176 (equal? '(1) (append-map noop '(() (1)))))
177
178 (pass-if "() (1 2)"
179 (equal? '(1 2) (append-map noop '(() (1 2)))))
180
181 (pass-if "(1) (2)"
182 (equal? '(1 2) (append-map noop '((1) (2)))))
183
184 (pass-if "(1 2) ()"
185 (equal? '(1 2) (append-map noop '(() (1 2))))))
186
187 (with-test-prefix "two lists"
188
189 (pass-if "() / 9"
190 (equal? '() (append-map noop '(()) '(9))))
191
192 (pass-if "(1) / 9"
193 (equal? '(1) (append-map noop '((1)) '(9))))
194
195 (pass-if "() () / 9 9"
196 (equal? '() (append-map noop '(() ()) '(9 9))))
197
198 (pass-if "(1) (2) / 9"
199 (equal? '(1) (append-map noop '((1) (2)) '(9))))
200
201 (pass-if "(1) (2) / 9 9"
202 (equal? '(1 2) (append-map noop '((1) (2)) '(9 9))))))
203
204 ;;
205 ;; break
206 ;;
207
208 (with-test-prefix "break"
209
210 (define (test-break lst want-v1 want-v2)
211 (call-with-values
212 (lambda ()
213 (break negative? lst))
214 (lambda (got-v1 got-v2)
215 (and (equal? got-v1 want-v1)
216 (equal? got-v2 want-v2)))))
217
218 (pass-if "empty"
219 (test-break '() '() '()))
220
221 (pass-if "y"
222 (test-break '(1) '(1) '()))
223
224 (pass-if "n"
225 (test-break '(-1) '() '(-1)))
226
227 (pass-if "yy"
228 (test-break '(1 2) '(1 2) '()))
229
230 (pass-if "ny"
231 (test-break '(-1 1) '() '(-1 1)))
232
233 (pass-if "yn"
234 (test-break '(1 -1) '(1) '(-1)))
235
236 (pass-if "nn"
237 (test-break '(-1 -2) '() '(-1 -2)))
238
239 (pass-if "yyy"
240 (test-break '(1 2 3) '(1 2 3) '()))
241
242 (pass-if "nyy"
243 (test-break '(-1 1 2) '() '(-1 1 2)))
244
245 (pass-if "yny"
246 (test-break '(1 -1 2) '(1) '(-1 2)))
247
248 (pass-if "nny"
249 (test-break '(-1 -2 1) '() '(-1 -2 1)))
250
251 (pass-if "yyn"
252 (test-break '(1 2 -1) '(1 2) '(-1)))
253
254 (pass-if "nyn"
255 (test-break '(-1 1 -2) '() '(-1 1 -2)))
256
257 (pass-if "ynn"
258 (test-break '(1 -1 -2) '(1) '(-1 -2)))
259
260 (pass-if "nnn"
261 (test-break '(-1 -2 -3) '() '(-1 -2 -3))))
262
263 ;;
264 ;; concatenate and concatenate!
265 ;;
266
267 (let ()
268 (define (common-tests concatenate-proc unmodified?)
269 (define (try lstlst want)
270 (let ((lstlst-copy (copy-tree lstlst))
271 (got (concatenate-proc lstlst)))
272 (if unmodified?
273 (if (not (equal? lstlst lstlst-copy))
274 (error "input lists modified")))
275 (equal? got want)))
276
277 (pass-if-exception "too few args" exception:wrong-num-args
278 (concatenate-proc))
279
280 (pass-if-exception "too many args" exception:wrong-num-args
281 (concatenate-proc '() '()))
282
283 (pass-if "no lists"
284 (try '() '()))
285
286 (pass-if (try '((1)) '(1)))
287 (pass-if (try '((1 2)) '(1 2)))
288 (pass-if (try '(() (1)) '(1)))
289 (pass-if (try '(() () (1)) '(1)))
290
291 (pass-if (try '((1) (2)) '(1 2)))
292 (pass-if (try '(() (1 2)) '(1 2)))
293
294 (pass-if (try '((1) 2) '(1 . 2)))
295 (pass-if (try '((1) (2) 3) '(1 2 . 3)))
296 (pass-if (try '((1) (2) (3 . 4)) '(1 2 3 . 4)))
297 )
298
299 (with-test-prefix "concatenate"
300 (common-tests concatenate #t))
301
302 (with-test-prefix "concatenate!"
303 (common-tests concatenate! #f)))
304
305 ;;
306 ;; count
307 ;;
308
309 (with-test-prefix "count"
310 (pass-if-exception "no args" exception:wrong-num-args
311 (count))
312
313 (pass-if-exception "one arg" exception:wrong-num-args
314 (count noop))
315
316 (with-test-prefix "one list"
317 (define (or1 x)
318 x)
319
320 (pass-if "empty list" (= 0 (count or1 '())))
321
322 (pass-if-exception "pred arg count 0" exception:wrong-type-arg
323 (count (lambda () x) '(1 2 3)))
324 (pass-if-exception "pred arg count 2" exception:wrong-type-arg
325 (count (lambda (x y) x) '(1 2 3)))
326
327 (pass-if-exception "improper 1" exception:wrong-type-arg
328 (count or1 1))
329 (pass-if-exception "improper 2" exception:wrong-type-arg
330 (count or1 '(1 . 2)))
331 (pass-if-exception "improper 3" exception:wrong-type-arg
332 (count or1 '(1 2 . 3)))
333
334 (pass-if (= 0 (count or1 '(#f))))
335 (pass-if (= 1 (count or1 '(#t))))
336
337 (pass-if (= 0 (count or1 '(#f #f))))
338 (pass-if (= 1 (count or1 '(#f #t))))
339 (pass-if (= 1 (count or1 '(#t #f))))
340 (pass-if (= 2 (count or1 '(#t #t))))
341
342 (pass-if (= 0 (count or1 '(#f #f #f))))
343 (pass-if (= 1 (count or1 '(#f #f #t))))
344 (pass-if (= 1 (count or1 '(#t #f #f))))
345 (pass-if (= 2 (count or1 '(#t #f #t))))
346 (pass-if (= 3 (count or1 '(#t #t #t)))))
347
348 (with-test-prefix "two lists"
349 (define (or2 x y)
350 (or x y))
351
352 (pass-if "arg order"
353 (= 1 (count (lambda (x y)
354 (and (= 1 x)
355 (= 2 y)))
356 '(1) '(2))))
357
358 (pass-if "empty lists" (= 0 (count or2 '() '())))
359
360 (pass-if-exception "pred arg count 0" exception:wrong-type-arg
361 (count (lambda () #t) '(1 2 3) '(1 2 3)))
362 (pass-if-exception "pred arg count 1" exception:wrong-type-arg
363 (count (lambda (x) x) '(1 2 3) '(1 2 3)))
364 (pass-if-exception "pred arg count 3" exception:wrong-type-arg
365 (count (lambda (x y z) x) '(1 2 3) '(1 2 3)))
366
367 (pass-if-exception "improper first 1" exception:wrong-type-arg
368 (count or2 1 '(1 2 3)))
369 (pass-if-exception "improper first 2" exception:wrong-type-arg
370 (count or2 '(1 . 2) '(1 2 3)))
371 (pass-if-exception "improper first 3" exception:wrong-type-arg
372 (count or2 '(1 2 . 3) '(1 2 3)))
373
374 (pass-if-exception "improper second 1" exception:wrong-type-arg
375 (count or2 '(1 2 3) 1))
376 (pass-if-exception "improper second 2" exception:wrong-type-arg
377 (count or2 '(1 2 3) '(1 . 2)))
378 (pass-if-exception "improper second 3" exception:wrong-type-arg
379 (count or2 '(1 2 3) '(1 2 . 3)))
380
381 (pass-if (= 0 (count or2 '(#f) '(#f))))
382 (pass-if (= 1 (count or2 '(#t) '(#f))))
383 (pass-if (= 1 (count or2 '(#f) '(#t))))
384
385 (pass-if (= 0 (count or2 '(#f #f) '(#f #f))))
386 (pass-if (= 1 (count or2 '(#t #f) '(#t #f))))
387 (pass-if (= 2 (count or2 '(#t #t) '(#f #f))))
388 (pass-if (= 2 (count or2 '(#t #f) '(#f #t))))
389
390 (with-test-prefix "stop shortest"
391 (pass-if (= 2 (count or2 '(#t #f #t) '(#f #t))))
392 (pass-if (= 2 (count or2 '(#t #f #t #t) '(#f #t))))
393 (pass-if (= 2 (count or2 '(#t #f) '(#f #t #t))))
394 (pass-if (= 2 (count or2 '(#t #f) '(#f #t #t #t))))))
395
396 (with-test-prefix "three lists"
397 (define (or3 x y z)
398 (or x y z))
399
400 (pass-if "arg order"
401 (= 1 (count (lambda (x y z)
402 (and (= 1 x)
403 (= 2 y)
404 (= 3 z)))
405 '(1) '(2) '(3))))
406
407 (pass-if "empty lists" (= 0 (count or3 '() '() '())))
408
409 ;; currently bad pred argument gives wrong-num-args when 3 or more
410 ;; lists, as opposed to wrong-type-arg for 1 or 2 lists
411 (pass-if-exception "pred arg count 0" exception:wrong-num-args
412 (count (lambda () #t) '(1 2 3) '(1 2 3) '(1 2 3)))
413 (pass-if-exception "pred arg count 2" exception:wrong-num-args
414 (count (lambda (x y) x) '(1 2 3) '(1 2 3)'(1 2 3) ))
415 (pass-if-exception "pred arg count 4" exception:wrong-num-args
416 (count (lambda (w x y z) x) '(1 2 3) '(1 2 3) '(1 2 3)))
417
418 (pass-if-exception "improper first 1" exception:wrong-type-arg
419 (count or3 1 '(1 2 3) '(1 2 3)))
420 (pass-if-exception "improper first 2" exception:wrong-type-arg
421 (count or3 '(1 . 2) '(1 2 3) '(1 2 3)))
422 (pass-if-exception "improper first 3" exception:wrong-type-arg
423 (count or3 '(1 2 . 3) '(1 2 3) '(1 2 3)))
424
425 (pass-if-exception "improper second 1" exception:wrong-type-arg
426 (count or3 '(1 2 3) 1 '(1 2 3)))
427 (pass-if-exception "improper second 2" exception:wrong-type-arg
428 (count or3 '(1 2 3) '(1 . 2) '(1 2 3)))
429 (pass-if-exception "improper second 3" exception:wrong-type-arg
430 (count or3 '(1 2 3) '(1 2 . 3) '(1 2 3)))
431
432 (pass-if-exception "improper third 1" exception:wrong-type-arg
433 (count or3 '(1 2 3) '(1 2 3) 1))
434 (pass-if-exception "improper third 2" exception:wrong-type-arg
435 (count or3 '(1 2 3) '(1 2 3) '(1 . 2)))
436 (pass-if-exception "improper third 3" exception:wrong-type-arg
437 (count or3 '(1 2 3) '(1 2 3) '(1 2 . 3)))
438
439 (pass-if (= 0 (count or3 '(#f) '(#f) '(#f))))
440 (pass-if (= 1 (count or3 '(#t) '(#f) '(#f))))
441 (pass-if (= 1 (count or3 '(#f) '(#t) '(#f))))
442 (pass-if (= 1 (count or3 '(#f) '(#f) '(#t))))
443
444 (pass-if (= 0 (count or3 '(#f #f) '(#f #f) '(#f #f))))
445
446 (pass-if (= 1 (count or3 '(#t #f) '(#f #f) '(#f #f))))
447 (pass-if (= 1 (count or3 '(#f #t) '(#f #f) '(#f #f))))
448 (pass-if (= 1 (count or3 '(#f #f) '(#t #f) '(#f #f))))
449 (pass-if (= 1 (count or3 '(#f #f) '(#f #t) '(#f #f))))
450 (pass-if (= 1 (count or3 '(#f #f) '(#f #f) '(#t #f))))
451 (pass-if (= 1 (count or3 '(#f #f) '(#f #f) '(#f #t))))
452
453 (pass-if (= 2 (count or3 '(#t #t) '(#f #f) '(#f #f))))
454 (pass-if (= 2 (count or3 '(#f #f) '(#t #t) '(#f #f))))
455 (pass-if (= 2 (count or3 '(#f #f) '(#f #f) '(#t #t))))
456 (pass-if (= 2 (count or3 '(#f #f) '(#t #f) '(#f #t))))
457
458 (with-test-prefix "stop shortest"
459 (pass-if (= 0 (count or3 '() '(#t #t #t) '(#t #t))))
460 (pass-if (= 0 (count or3 '(#t #t #t) '() '(#t #t))))
461 (pass-if (= 0 (count or3 '(#t #t #t) '(#t #t) '())))
462
463 (pass-if (= 1 (count or3 '(#t) '(#t #t #t) '(#t #t))))
464 (pass-if (= 1 (count or3 '(#t #t #t) '(#t) '(#t #t))))
465 (pass-if (= 1 (count or3 '(#t #t #t) '(#t #t) '(#t)))))))
466
467 ;;
468 ;; delete and delete!
469 ;;
470
471 (let ()
472 ;; Call (PROC lst) for all lists of length up to 6, with all combinations
473 ;; of elements to be retained or deleted. Elements to retain are numbers,
474 ;; 0 upwards. Elements to be deleted are #f.
475 (define (test-lists proc)
476 (do ((n 0 (1+ n)))
477 ((>= n 6))
478 (do ((limit (ash 1 n))
479 (i 0 (1+ i)))
480 ((>= i limit))
481 (let ((lst '()))
482 (do ((bit 0 (1+ bit)))
483 ((>= bit n))
484 (set! lst (cons (if (logbit? bit i) bit #f) lst)))
485 (proc lst)))))
486
487 (define (common-tests delete-proc)
488 (pass-if-exception "too few args" exception:wrong-num-args
489 (delete-proc 0))
490
491 (pass-if-exception "too many args" exception:wrong-num-args
492 (delete-proc 0 '() equal? 99))
493
494 (pass-if "empty"
495 (eq? '() (delete-proc 0 '())))
496
497 (pass-if "equal? (the default)"
498 (equal? '((1) (3))
499 (delete-proc '(2) '((1) (2) (3)))))
500
501 (pass-if "eq?"
502 (equal? '((1) (2) (3))
503 (delete-proc '(2) '((1) (2) (3)) eq?)))
504
505 (pass-if "called arg order"
506 (equal? '(1 2 3)
507 (delete-proc 3 '(1 2 3 4 5) <))))
508
509 (with-test-prefix "delete"
510 (common-tests delete)
511
512 (test-lists
513 (lambda (lst)
514 (let ((lst-copy (list-copy lst)))
515 (with-test-prefix lst-copy
516 (pass-if "result"
517 (equal? (delete #f lst)
518 (ref-delete #f lst)))
519 (pass-if "non-destructive"
520 (equal? lst-copy lst)))))))
521
522 (with-test-prefix "delete!"
523 (common-tests delete!)
524
525 (test-lists
526 (lambda (lst)
527 (pass-if lst
528 (equal? (delete! #f lst)
529 (ref-delete #f lst)))))))
530
531 ;;
532 ;; delete-duplicates and delete-duplicates!
533 ;;
534
535 (let ()
536 ;; Call (PROC lst) for all lists of length 1 <= n <= 4, with all
537 ;; combinations of numbers 1 to n in the elements
538 (define (test-lists proc)
539 (do ((n 1 (1+ n)))
540 ((> n 4))
541 (do ((limit (integer-expt n n))
542 (i 0 (1+ i)))
543 ((>= i limit))
544 (let ((lst '()))
545 (do ((j 0 (1+ j))
546 (rem i (quotient rem n)))
547 ((>= j n))
548 (set! lst (cons (remainder rem n) lst)))
549 (proc lst)))))
550
551 (define (common-tests delete-duplicates-proc)
552 (pass-if-exception "too few args" exception:wrong-num-args
553 (delete-duplicates-proc))
554
555 (pass-if-exception "too many args" exception:wrong-num-args
556 (delete-duplicates-proc '() equal? 99))
557
558 (pass-if "empty"
559 (eq? '() (delete-duplicates-proc '())))
560
561 (pass-if "equal? (the default)"
562 (equal? '((2))
563 (delete-duplicates-proc '((2) (2) (2)))))
564
565 (pass-if "eq?"
566 (equal? '((2) (2) (2))
567 (delete-duplicates-proc '((2) (2) (2)) eq?)))
568
569 (pass-if "called arg order"
570 (let ((ok #t))
571 (delete-duplicates-proc '(1 2 3 4 5)
572 (lambda (x y)
573 (if (> x y)
574 (set! ok #f))
575 #f))
576 ok)))
577
578 (with-test-prefix "delete-duplicates"
579 (common-tests delete-duplicates)
580
581 (test-lists
582 (lambda (lst)
583 (let ((lst-copy (list-copy lst)))
584 (with-test-prefix lst-copy
585 (pass-if "result"
586 (equal? (delete-duplicates lst)
587 (ref-delete-duplicates lst)))
588 (pass-if "non-destructive"
589 (equal? lst-copy lst)))))))
590
591 (with-test-prefix "delete-duplicates!"
592 (common-tests delete-duplicates!)
593
594 (test-lists
595 (lambda (lst)
596 (pass-if lst
597 (equal? (delete-duplicates! lst)
598 (ref-delete-duplicates lst)))))))
599
600 ;;
601 ;; drop
602 ;;
603
604 (with-test-prefix "drop"
605
606 (pass-if "'() 0"
607 (null? (drop '() 0)))
608
609 (pass-if "'(a) 0"
610 (let ((lst '(a)))
611 (eq? lst
612 (drop lst 0))))
613
614 (pass-if "'(a b) 0"
615 (let ((lst '(a b)))
616 (eq? lst
617 (drop lst 0))))
618
619 (pass-if "'(a) 1"
620 (let ((lst '(a)))
621 (eq? (cdr lst)
622 (drop lst 1))))
623
624 (pass-if "'(a b) 1"
625 (let ((lst '(a b)))
626 (eq? (cdr lst)
627 (drop lst 1))))
628
629 (pass-if "'(a b) 2"
630 (let ((lst '(a b)))
631 (eq? (cddr lst)
632 (drop lst 2))))
633
634 (pass-if "'(a b c) 1"
635 (let ((lst '(a b c)))
636 (eq? (cddr lst)
637 (drop lst 2))))
638
639 (pass-if "circular '(a) 0"
640 (let ((lst (circular-list 'a)))
641 (eq? lst
642 (drop lst 0))))
643
644 (pass-if "circular '(a) 1"
645 (let ((lst (circular-list 'a)))
646 (eq? lst
647 (drop lst 1))))
648
649 (pass-if "circular '(a) 2"
650 (let ((lst (circular-list 'a)))
651 (eq? lst
652 (drop lst 1))))
653
654 (pass-if "circular '(a b) 1"
655 (let ((lst (circular-list 'a)))
656 (eq? (cdr lst)
657 (drop lst 0))))
658
659 (pass-if "circular '(a b) 2"
660 (let ((lst (circular-list 'a)))
661 (eq? lst
662 (drop lst 1))))
663
664 (pass-if "circular '(a b) 5"
665 (let ((lst (circular-list 'a)))
666 (eq? (cdr lst)
667 (drop lst 5))))
668
669 (pass-if "'(a . b) 1"
670 (eq? 'b
671 (drop '(a . b) 1)))
672
673 (pass-if "'(a b . c) 1"
674 (equal? 'c
675 (drop '(a b . c) 2))))
676
677 ;;
678 ;; filter-map
679 ;;
680
681 (with-test-prefix "filter-map"
682
683 (with-test-prefix "one list"
684 (pass-if "(1)"
685 (equal? '(1) (filter-map noop '(1))))
686
687 (pass-if "(#f)"
688 (equal? '() (filter-map noop '(#f))))
689
690 (pass-if "(1 2)"
691 (equal? '(1 2) (filter-map noop '(1 2))))
692
693 (pass-if "(#f 2)"
694 (equal? '(2) (filter-map noop '(#f 2))))
695
696 (pass-if "(#f #f)"
697 (equal? '() (filter-map noop '(#f #f))))
698
699 (pass-if "(1 2 3)"
700 (equal? '(1 2 3) (filter-map noop '(1 2 3))))
701
702 (pass-if "(#f 2 3)"
703 (equal? '(2 3) (filter-map noop '(#f 2 3))))
704
705 (pass-if "(1 #f 3)"
706 (equal? '(1 3) (filter-map noop '(1 #f 3))))
707
708 (pass-if "(1 2 #f)"
709 (equal? '(1 2) (filter-map noop '(1 2 #f)))))
710
711 (with-test-prefix "two lists"
712 (pass-if "(1 2 3) (4 5 6)"
713 (equal? '(1 2 3) (filter-map noop '(1 2 3) '(4 5 6))))
714
715 (pass-if "(#f 2 3) (4 5)"
716 (equal? '(2) (filter-map noop '(#f 2 3) '(4 5))))
717
718 (pass-if "(4 #f) (1 2 3)"
719 (equal? '(4) (filter-map noop '(4 #f) '(1 2 3))))))
720
721 ;;
722 ;; find
723 ;;
724
725 (with-test-prefix "find"
726 (pass-if (eqv? #f (find odd? '())))
727 (pass-if (eqv? #f (find odd? '(0))))
728 (pass-if (eqv? #f (find odd? '(0 2))))
729 (pass-if (eqv? 1 (find odd? '(1))))
730 (pass-if (eqv? 1 (find odd? '(0 1))))
731 (pass-if (eqv? 1 (find odd? '(0 1 2))))
732 (pass-if (eqv? 1 (find odd? '(2 0 1))))
733 (pass-if (eqv? 1 (find (lambda (x) (= 1 x)) '(2 0 1)))))
734
735 ;;
736 ;; find-tail
737 ;;
738
739 (with-test-prefix "find-tail"
740 (pass-if (let ((lst '()))
741 (eq? #f (find-tail odd? lst))))
742 (pass-if (let ((lst '(0)))
743 (eq? #f (find-tail odd? lst))))
744 (pass-if (let ((lst '(0 2)))
745 (eq? #f (find-tail odd? lst))))
746 (pass-if (let ((lst '(1)))
747 (eq? lst (find-tail odd? lst))))
748 (pass-if (let ((lst '(1 2)))
749 (eq? lst (find-tail odd? lst))))
750 (pass-if (let ((lst '(2 1)))
751 (eq? (cdr lst) (find-tail odd? lst))))
752 (pass-if (let ((lst '(2 1 0)))
753 (eq? (cdr lst) (find-tail odd? lst))))
754 (pass-if (let ((lst '(2 0 1)))
755 (eq? (cddr lst) (find-tail odd? lst))))
756 (pass-if (let ((lst '(2 0 1)))
757 (eq? (cddr lst) (find-tail (lambda (x) (= 1 x)) lst)))))
758
759 ;;
760 ;; length+
761 ;;
762
763 (with-test-prefix "length+"
764 (pass-if-exception "too few args" exception:wrong-num-args
765 (length+))
766 (pass-if-exception "too many args" exception:wrong-num-args
767 (length+ 123 456))
768 (pass-if (= 0 (length+ '())))
769 (pass-if (= 1 (length+ '(x))))
770 (pass-if (= 2 (length+ '(x y))))
771 (pass-if (= 3 (length+ '(x y z))))
772 (pass-if (not (length+ (circular-list 1))))
773 (pass-if (not (length+ (circular-list 1 2))))
774 (pass-if (not (length+ (circular-list 1 2 3)))))
775
776 ;;
777 ;; list=
778 ;;
779
780 (with-test-prefix "list="
781
782 (pass-if "no lists"
783 (eq? #t (list= eqv?)))
784
785 (with-test-prefix "one list"
786
787 (pass-if "empty"
788 (eq? #t (list= eqv? '())))
789 (pass-if "one elem"
790 (eq? #t (list= eqv? '(1))))
791 (pass-if "two elems"
792 (eq? #t (list= eqv? '(2)))))
793
794 (with-test-prefix "two lists"
795
796 (pass-if "empty / empty"
797 (eq? #t (list= eqv? '() '())))
798
799 (pass-if "one / empty"
800 (eq? #f (list= eqv? '(1) '())))
801
802 (pass-if "empty / one"
803 (eq? #f (list= eqv? '() '(1))))
804
805 (pass-if "one / one same"
806 (eq? #t (list= eqv? '(1) '(1))))
807
808 (pass-if "one / one diff"
809 (eq? #f (list= eqv? '(1) '(2))))
810
811 (pass-if "called arg order"
812 (let ((good #t))
813 (list= (lambda (x y)
814 (set! good (and good (= (1+ x) y)))
815 #t)
816 '(1 3) '(2 4))
817 good)))
818
819 (with-test-prefix "three lists"
820
821 (pass-if "empty / empty / empty"
822 (eq? #t (list= eqv? '() '() '())))
823
824 (pass-if "one / empty / empty"
825 (eq? #f (list= eqv? '(1) '() '())))
826
827 (pass-if "one / one / empty"
828 (eq? #f (list= eqv? '(1) '(1) '())))
829
830 (pass-if "one / diff / empty"
831 (eq? #f (list= eqv? '(1) '(2) '())))
832
833 (pass-if "one / one / one"
834 (eq? #t (list= eqv? '(1) '(1) '(1))))
835
836 (pass-if "two / two / diff"
837 (eq? #f (list= eqv? '(1 2) '(1 2) '(1 99))))
838
839 (pass-if "two / two / two"
840 (eq? #t (list= eqv? '(1 2) '(1 2) '(1 2))))
841
842 (pass-if "called arg order"
843 (let ((good #t))
844 (list= (lambda (x y)
845 (set! good (and good (= (1+ x) y)))
846 #t)
847 '(1 4) '(2 5) '(3 6))
848 good))))
849
850 ;;
851 ;; list-copy
852 ;;
853
854 (with-test-prefix "list-copy"
855 (pass-if (equal? '() (list-copy '())))
856 (pass-if (equal? '(1 2) (list-copy '(1 2))))
857 (pass-if (equal? '(1 2 3) (list-copy '(1 2 3))))
858 (pass-if (equal? '(1 2 3 4) (list-copy '(1 2 3 4))))
859 (pass-if (equal? '(1 2 3 4 5) (list-copy '(1 2 3 4 5))))
860
861 ;; improper lists can be copied
862 (pass-if (equal? 1 (list-copy 1)))
863 (pass-if (equal? '(1 . 2) (list-copy '(1 . 2))))
864 (pass-if (equal? '(1 2 . 3) (list-copy '(1 2 . 3))))
865 (pass-if (equal? '(1 2 3 . 4) (list-copy '(1 2 3 . 4))))
866 (pass-if (equal? '(1 2 3 4 . 5) (list-copy '(1 2 3 4 . 5)))))
867
868 ;;
869 ;; lset=
870 ;;
871
872 (with-test-prefix "lset="
873
874 ;; in guile 1.6.7 and earlier, lset= incorrectly demanded at least one
875 ;; list arg
876 (pass-if "no args"
877 (eq? #t (lset= eq?)))
878
879 (with-test-prefix "one arg"
880
881 (pass-if "()"
882 (eq? #t (lset= eqv? '())))
883
884 (pass-if "(1)"
885 (eq? #t (lset= eqv? '(1))))
886
887 (pass-if "(1 2)"
888 (eq? #t (lset= eqv? '(1 2)))))
889
890 (with-test-prefix "two args"
891
892 (pass-if "() ()"
893 (eq? #t (lset= eqv? '() '())))
894
895 (pass-if "(1) (1)"
896 (eq? #t (lset= eqv? '(1) '(1))))
897
898 (pass-if "(1) (2)"
899 (eq? #f (lset= eqv? '(1) '(2))))
900
901 (pass-if "(1) (1 2)"
902 (eq? #f (lset= eqv? '(1) '(1 2))))
903
904 (pass-if "(1 2) (2 1)"
905 (eq? #t (lset= eqv? '(1 2) '(2 1))))
906
907 (pass-if "called arg order"
908 (let ((good #t))
909 (lset= (lambda (x y)
910 (if (not (= x (1- y)))
911 (set! good #f))
912 #t)
913 '(1 1) '(2 2))
914 good)))
915
916 (with-test-prefix "three args"
917
918 (pass-if "() () ()"
919 (eq? #t (lset= eqv? '() '() '())))
920
921 (pass-if "(1) (1) (1)"
922 (eq? #t (lset= eqv? '(1) '(1) '(1))))
923
924 (pass-if "(1) (1) (2)"
925 (eq? #f (lset= eqv? '(1) '(1) '(2))))
926
927 (pass-if "(1) (1) (1 2)"
928 (eq? #f (lset= eqv? '(1) '(1) '(1 2))))
929
930 (pass-if "(1 2 3) (3 2 1) (1 3 2)"
931 (eq? #t (lset= eqv? '(1 2 3) '(3 2 1) '(1 3 2))))
932
933 (pass-if "called arg order"
934 (let ((good #t))
935 (lset= (lambda (x y)
936 (if (not (= x (1- y)))
937 (set! good #f))
938 #t)
939 '(1 1) '(2 2) '(3 3))
940 good))))
941
942 ;;
943 ;; lset-adjoin
944 ;;
945
946 (with-test-prefix "lset-adjoin"
947
948 ;; in guile 1.6.7 and earlier, lset-adjoin didn't actually use the given
949 ;; `=' procedure, all comparisons were just with `equal?
950 ;;
951 (with-test-prefix "case-insensitive ="
952
953 (pass-if "(\"x\") \"X\""
954 (equal? '("x") (lset-adjoin string-ci=? '("x") "X"))))
955
956 (pass-if "called arg order"
957 (let ((good #f))
958 (lset-adjoin (lambda (x y)
959 (set! good (and (= x 1) (= y 2)))
960 (= x y))
961 '(1) 2)
962 good))
963
964 (pass-if "(1 1) 1 1"
965 (equal? '(1 1) (lset-adjoin = '(1 1) 1 1)))
966
967 ;; duplicates among args are cast out
968 (pass-if "(2) 1 1"
969 (equal? '(1 2) (lset-adjoin = '(2) 1 1))))
970
971 ;;
972 ;; lset-union
973 ;;
974
975 (with-test-prefix "lset-union"
976
977 (pass-if "no args"
978 (eq? '() (lset-union eq?)))
979
980 (pass-if "one arg"
981 (equal? '(1 2 3) (lset-union eq? '(1 2 3))))
982
983 ;; in guile 1.6.7 and earlier, `=' was called with the arguments the wrong
984 ;; way around
985 (pass-if "called arg order"
986 (let ((good #f))
987 (lset-union (lambda (x y)
988 (set! good (and (= x 1) (= y 2)))
989 (= x y))
990 '(1) '(2))
991 good)))
992
993 ;;
994 ;; member
995 ;;
996
997 (with-test-prefix "member"
998
999 (pass-if-exception "no args" exception:wrong-num-args
1000 (member))
1001
1002 (pass-if-exception "one arg" exception:wrong-num-args
1003 (member 1))
1004
1005 (pass-if "1 (1 2 3)"
1006 (let ((lst '(1 2 3)))
1007 (eq? lst (member 1 lst))))
1008
1009 (pass-if "2 (1 2 3)"
1010 (let ((lst '(1 2 3)))
1011 (eq? (cdr lst) (member 2 lst))))
1012
1013 (pass-if "3 (1 2 3)"
1014 (let ((lst '(1 2 3)))
1015 (eq? (cddr lst) (member 3 lst))))
1016
1017 (pass-if "4 (1 2 3)"
1018 (let ((lst '(1 2 3)))
1019 (eq? #f (member 4 lst))))
1020
1021 (pass-if "called arg order"
1022 (let ((good #f))
1023 (member 1 '(2) (lambda (x y)
1024 (set! good (and (eqv? 1 x)
1025 (eqv? 2 y)))))
1026 good)))
1027
1028 ;;
1029 ;; take
1030 ;;
1031
1032 (with-test-prefix "take"
1033
1034 (pass-if "'() 0"
1035 (null? (take '() 0)))
1036
1037 (pass-if "'(a) 0"
1038 (null? (take '(a) 0)))
1039
1040 (pass-if "'(a b) 0"
1041 (null? (take '() 0)))
1042
1043 (pass-if "'(a b c) 0"
1044 (null? (take '() 0)))
1045
1046 (pass-if "'(a) 1"
1047 (let* ((lst '(a))
1048 (got (take lst 1)))
1049 (and (equal? '(a) got)
1050 (not (eq? lst got)))))
1051
1052 (pass-if "'(a b) 1"
1053 (equal? '(a)
1054 (take '(a b) 1)))
1055
1056 (pass-if "'(a b c) 1"
1057 (equal? '(a)
1058 (take '(a b c) 1)))
1059
1060 (pass-if "'(a b) 2"
1061 (let* ((lst '(a b))
1062 (got (take lst 2)))
1063 (and (equal? '(a b) got)
1064 (not (eq? lst got)))))
1065
1066 (pass-if "'(a b c) 2"
1067 (equal? '(a b)
1068 (take '(a b c) 2)))
1069
1070 (pass-if "circular '(a) 0"
1071 (equal? '()
1072 (take (circular-list 'a) 0)))
1073
1074 (pass-if "circular '(a) 1"
1075 (equal? '(a)
1076 (take (circular-list 'a) 1)))
1077
1078 (pass-if "circular '(a) 2"
1079 (equal? '(a a)
1080 (take (circular-list 'a) 2)))
1081
1082 (pass-if "circular '(a b) 5"
1083 (equal? '(a b a b a)
1084 (take (circular-list 'a 'b) 5)))
1085
1086 (pass-if "'(a . b) 1"
1087 (equal? '(a)
1088 (take '(a . b) 1)))
1089
1090 (pass-if "'(a b . c) 1"
1091 (equal? '(a)
1092 (take '(a b . c) 1)))
1093
1094 (pass-if "'(a b . c) 2"
1095 (equal? '(a b)
1096 (take '(a b . c) 2))))
1097
1098 ;;
1099 ;; partition
1100 ;;
1101
1102 (define (test-partition pred list kept-good dropped-good)
1103 (call-with-values (lambda ()
1104 (partition pred list))
1105 (lambda (kept dropped)
1106 (and (equal? kept kept-good)
1107 (equal? dropped dropped-good)))))
1108
1109 (with-test-prefix "partition"
1110
1111 (pass-if "with dropped tail"
1112 (test-partition even? '(1 2 3 4 5 6 7)
1113 '(2 4 6) '(1 3 5 7)))
1114
1115 (pass-if "with kept tail"
1116 (test-partition even? '(1 2 3 4 5 6)
1117 '(2 4 6) '(1 3 5)))
1118
1119 (pass-if "with everything dropped"
1120 (test-partition even? '(1 3 5 7)
1121 '() '(1 3 5 7)))
1122
1123 (pass-if "with everything kept"
1124 (test-partition even? '(2 4 6)
1125 '(2 4 6) '()))
1126
1127 (pass-if "with empty list"
1128 (test-partition even? '()
1129 '() '()))
1130
1131 (pass-if "with reasonably long list"
1132 ;; the old implementation from SRFI-1 reference implementation
1133 ;; would signal a stack-overflow for a list of only 500 elements!
1134 (call-with-values (lambda ()
1135 (partition even?
1136 (make-list 10000 1)))
1137 (lambda (even odd)
1138 (and (= (length odd) 10000)
1139 (= (length even) 0))))))
1140
1141 ;;
1142 ;; reduce
1143 ;;
1144
1145 (with-test-prefix "reduce"
1146
1147 (pass-if "empty"
1148 (let* ((calls '())
1149 (ret (reduce (lambda (x prev)
1150 (set! calls (cons (list x prev) calls))
1151 x)
1152 1 '())))
1153 (and (equal? calls '())
1154 (equal? ret 1))))
1155
1156 (pass-if "one elem"
1157 (let* ((calls '())
1158 (ret (reduce (lambda (x prev)
1159 (set! calls (cons (list x prev) calls))
1160 x)
1161 1 '(2))))
1162 (and (equal? calls '())
1163 (equal? ret 2))))
1164
1165 (pass-if "two elems"
1166 (let* ((calls '())
1167 (ret (reduce (lambda (x prev)
1168 (set! calls (cons (list x prev) calls))
1169 x)
1170 1 '(2 3))))
1171 (and (equal? calls '((3 2)))
1172 (equal? ret 3))))
1173
1174 (pass-if "three elems"
1175 (let* ((calls '())
1176 (ret (reduce (lambda (x prev)
1177 (set! calls (cons (list x prev) calls))
1178 x)
1179 1 '(2 3 4))))
1180 (and (equal? calls '((4 3)
1181 (3 2)))
1182 (equal? ret 4))))
1183
1184 (pass-if "four elems"
1185 (let* ((calls '())
1186 (ret (reduce (lambda (x prev)
1187 (set! calls (cons (list x prev) calls))
1188 x)
1189 1 '(2 3 4 5))))
1190 (and (equal? calls '((5 4)
1191 (4 3)
1192 (3 2)))
1193 (equal? ret 5)))))
1194
1195 ;;
1196 ;; reduce-right
1197 ;;
1198
1199 (with-test-prefix "reduce-right"
1200
1201 (pass-if "empty"
1202 (let* ((calls '())
1203 (ret (reduce-right (lambda (x prev)
1204 (set! calls (cons (list x prev) calls))
1205 x)
1206 1 '())))
1207 (and (equal? calls '())
1208 (equal? ret 1))))
1209
1210 (pass-if "one elem"
1211 (let* ((calls '())
1212 (ret (reduce-right (lambda (x prev)
1213 (set! calls (cons (list x prev) calls))
1214 x)
1215 1 '(2))))
1216 (and (equal? calls '())
1217 (equal? ret 2))))
1218
1219 (pass-if "two elems"
1220 (let* ((calls '())
1221 (ret (reduce-right (lambda (x prev)
1222 (set! calls (cons (list x prev) calls))
1223 x)
1224 1 '(2 3))))
1225 (and (equal? calls '((2 3)))
1226 (equal? ret 2))))
1227
1228 (pass-if "three elems"
1229 (let* ((calls '())
1230 (ret (reduce-right (lambda (x prev)
1231 (set! calls (cons (list x prev) calls))
1232 x)
1233 1 '(2 3 4))))
1234 (and (equal? calls '((2 3)
1235 (3 4)))
1236 (equal? ret 2))))
1237
1238 (pass-if "four elems"
1239 (let* ((calls '())
1240 (ret (reduce-right (lambda (x prev)
1241 (set! calls (cons (list x prev) calls))
1242 x)
1243 1 '(2 3 4 5))))
1244 (and (equal? calls '((2 3)
1245 (3 4)
1246 (4 5)))
1247 (equal? ret 2)))))
1248
1249 ;;
1250 ;; remove
1251 ;;
1252
1253 (with-test-prefix "remove"
1254
1255 (pass-if (equal? '() (remove odd? '())))
1256 (pass-if (equal? '() (remove odd? '(1))))
1257 (pass-if (equal? '(2) (remove odd? '(2))))
1258
1259 (pass-if (equal? '() (remove odd? '(1 3))))
1260 (pass-if (equal? '(2) (remove odd? '(2 3))))
1261 (pass-if (equal? '(2) (remove odd? '(1 2))))
1262 (pass-if (equal? '(2 4) (remove odd? '(2 4))))
1263
1264 (pass-if (equal? '() (remove odd? '(1 3 5))))
1265 (pass-if (equal? '(2) (remove odd? '(2 3 5))))
1266 (pass-if (equal? '(2) (remove odd? '(1 2 5))))
1267 (pass-if (equal? '(2 4) (remove odd? '(2 4 5))))
1268
1269 (pass-if (equal? '(6) (remove odd? '(1 3 6))))
1270 (pass-if (equal? '(2 6) (remove odd? '(2 3 6))))
1271 (pass-if (equal? '(2 6) (remove odd? '(1 2 6))))
1272 (pass-if (equal? '(2 4 6) (remove odd? '(2 4 6)))))
1273
1274 ;;
1275 ;; remove!
1276 ;;
1277
1278 (with-test-prefix "remove!"
1279
1280 (pass-if (equal? '() (remove! odd? '())))
1281 (pass-if (equal? '() (remove! odd? (list 1))))
1282 (pass-if (equal? '(2) (remove! odd? (list 2))))
1283
1284 (pass-if (equal? '() (remove! odd? (list 1 3))))
1285 (pass-if (equal? '(2) (remove! odd? (list 2 3))))
1286 (pass-if (equal? '(2) (remove! odd? (list 1 2))))
1287 (pass-if (equal? '(2 4) (remove! odd? (list 2 4))))
1288
1289 (pass-if (equal? '() (remove! odd? (list 1 3 5))))
1290 (pass-if (equal? '(2) (remove! odd? (list 2 3 5))))
1291 (pass-if (equal? '(2) (remove! odd? (list 1 2 5))))
1292 (pass-if (equal? '(2 4) (remove! odd? (list 2 4 5))))
1293
1294 (pass-if (equal? '(6) (remove! odd? (list 1 3 6))))
1295 (pass-if (equal? '(2 6) (remove! odd? (list 2 3 6))))
1296 (pass-if (equal? '(2 6) (remove! odd? (list 1 2 6))))
1297 (pass-if (equal? '(2 4 6) (remove! odd? (list 2 4 6)))))
1298
1299 ;;
1300 ;; span
1301 ;;
1302
1303 (with-test-prefix "span"
1304
1305 (define (test-span lst want-v1 want-v2)
1306 (call-with-values
1307 (lambda ()
1308 (span positive? lst))
1309 (lambda (got-v1 got-v2)
1310 (and (equal? got-v1 want-v1)
1311 (equal? got-v2 want-v2)))))
1312
1313 (pass-if "empty"
1314 (test-span '() '() '()))
1315
1316 (pass-if "y"
1317 (test-span '(1) '(1) '()))
1318
1319 (pass-if "n"
1320 (test-span '(-1) '() '(-1)))
1321
1322 (pass-if "yy"
1323 (test-span '(1 2) '(1 2) '()))
1324
1325 (pass-if "ny"
1326 (test-span '(-1 1) '() '(-1 1)))
1327
1328 (pass-if "yn"
1329 (test-span '(1 -1) '(1) '(-1)))
1330
1331 (pass-if "nn"
1332 (test-span '(-1 -2) '() '(-1 -2)))
1333
1334 (pass-if "yyy"
1335 (test-span '(1 2 3) '(1 2 3) '()))
1336
1337 (pass-if "nyy"
1338 (test-span '(-1 1 2) '() '(-1 1 2)))
1339
1340 (pass-if "yny"
1341 (test-span '(1 -1 2) '(1) '(-1 2)))
1342
1343 (pass-if "nny"
1344 (test-span '(-1 -2 1) '() '(-1 -2 1)))
1345
1346 (pass-if "yyn"
1347 (test-span '(1 2 -1) '(1 2) '(-1)))
1348
1349 (pass-if "nyn"
1350 (test-span '(-1 1 -2) '() '(-1 1 -2)))
1351
1352 (pass-if "ynn"
1353 (test-span '(1 -1 -2) '(1) '(-1 -2)))
1354
1355 (pass-if "nnn"
1356 (test-span '(-1 -2 -3) '() '(-1 -2 -3))))