mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-17 17:20:29 +02:00
(partition): New tests, by Matthias Koeppe.
This commit is contained in:
parent
49d2f1f850
commit
cabc854555
1 changed files with 43 additions and 0 deletions
|
@ -415,3 +415,46 @@
|
||||||
(pass-if "(1 2) / (3 4) / (5 6)"
|
(pass-if "(1 2) / (3 4) / (5 6)"
|
||||||
(equal? '(9 12) (map + '(1 2) '(3 4) '(5 6))))))
|
(equal? '(9 12) (map + '(1 2) '(3 4) '(5 6))))))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; partition
|
||||||
|
;;
|
||||||
|
|
||||||
|
(define (test-partition pred list kept-good dropped-good)
|
||||||
|
(call-with-values (lambda ()
|
||||||
|
(partition pred list))
|
||||||
|
(lambda (kept dropped)
|
||||||
|
(and (equal? kept kept-good)
|
||||||
|
(equal? dropped dropped-good)))))
|
||||||
|
|
||||||
|
(with-test-prefix "partition"
|
||||||
|
|
||||||
|
(pass-if "with dropped tail"
|
||||||
|
(test-partition even? '(1 2 3 4 5 6 7)
|
||||||
|
'(2 4 6) '(1 3 5 7)))
|
||||||
|
|
||||||
|
(pass-if "with kept tail"
|
||||||
|
(test-partition even? '(1 2 3 4 5 6)
|
||||||
|
'(2 4 6) '(1 3 5)))
|
||||||
|
|
||||||
|
(pass-if "with everything dropped"
|
||||||
|
(test-partition even? '(1 3 5 7)
|
||||||
|
'() '(1 3 5 7)))
|
||||||
|
|
||||||
|
(pass-if "with everything kept"
|
||||||
|
(test-partition even? '(2 4 6)
|
||||||
|
'(2 4 6) '()))
|
||||||
|
|
||||||
|
(pass-if "with empty list"
|
||||||
|
(test-partition even? '()
|
||||||
|
'() '()))
|
||||||
|
|
||||||
|
(pass-if "with reasonably long list"
|
||||||
|
;; the old implementation from SRFI-1 reference implementation
|
||||||
|
;; would signal a stack-overflow for a list of only 500 elements!
|
||||||
|
(call-with-values (lambda ()
|
||||||
|
(partition even?
|
||||||
|
(make-list 10000 1)))
|
||||||
|
(lambda (even odd)
|
||||||
|
(and (= (length odd) 10000)
|
||||||
|
(= (length even) 0))))))
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue