mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 22:10:21 +02:00
Code Activity

(span): New tests.

Browse source
This commit is contained in:
Kevin Ryde 2004-12-06 00:33:40 +00:00
parent 872223a898
commit ee0301df8c
1 changed files with 58 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

58
test-suite/tests/srfi-1.test
View file

@ -807,3 +807,61 @@
(and (= (length odd) 10000)
(= (length even) 0))))))
;;
;; span
;;
(with-test-prefix "span"
(define (test-span lst want-v1 want-v2)
(call-with-values
(lambda ()
(span positive? lst))
(lambda (got-v1 got-v2)
(and (equal? got-v1 want-v1)
(equal? got-v2 want-v2)))))
(pass-if "empty"
(test-span '() '() '()))
(pass-if "y"
(test-span '(1) '(1) '()))
(pass-if "n"
(test-span '(-1) '() '(-1)))
(pass-if "yy"
(test-span '(1 2) '(1 2) '()))
(pass-if "ny"
(test-span '(-1 1) '() '(-1 1)))
(pass-if "yn"
(test-span '(1 -1) '(1) '(-1)))
(pass-if "nn"
(test-span '(-1 -2) '() '(-1 -2)))
(pass-if "yyy"
(test-span '(1 2 3) '(1 2 3) '()))
(pass-if "nyy"
(test-span '(-1 1 2) '() '(-1 1 2)))
(pass-if "yny"
(test-span '(1 -1 2) '(1) '(-1 2)))
(pass-if "nny"
(test-span '(-1 -2 1) '() '(-1 -2 1)))
(pass-if "yyn"
(test-span '(1 2 -1) '(1 2) '(-1)))
(pass-if "nyn"
(test-span '(-1 1 -2) '() '(-1 1 -2)))
(pass-if "ynn"
(test-span '(1 -1 -2) '(1) '(-1 -2)))
(pass-if "nnn"
(test-span '(-1 -2 -3) '() '(-1 -2 -3))))