155 lines
5.0 KiB
Scheme
155 lines
5.0 KiB
Scheme
#!r6rs
|
|
|
|
(library (tests r6rs lists)
|
|
(export run-lists-tests)
|
|
(import (rnrs)
|
|
(tests r6rs test))
|
|
|
|
(define (run-lists-tests)
|
|
|
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Tests originally from R6RS
|
|
|
|
(test (find even? '(3 1 4 1 5 9)) 4)
|
|
(test (find even? '(3 1 5 1 5 9)) #f)
|
|
|
|
(test (for-all even? '()) #t)
|
|
(test (for-all even? '(3 1 4 1 5 9)) #f)
|
|
;; (test (for-all even? '(3 1 4 1 5 9 . 2)) #f) ; removed from R6RS
|
|
(test (for-all even? '(2 4 14)) #t)
|
|
(test/exn (for-all even? '(2 4 14 . 9)) &assertion)
|
|
(test (for-all (lambda (n) (and (even? n) n))
|
|
'(2 4 14))
|
|
14)
|
|
(test (for-all < '(1 2 3) '(2 3 4)) #t)
|
|
(test (for-all < '(1 2 4) '(2 3 4)) #f)
|
|
|
|
(test (exists even? '(3 1 4 1 5 9)) #t)
|
|
(test (exists even? '(3 1 1 5 9)) #f)
|
|
(test (exists even? '()) #f)
|
|
(test/exn (exists even? '(3 1 1 5 9 . 2)) &assertion)
|
|
(test (exists (lambda (n) (and (even? n) n)) '(2 1 4 14)) 2)
|
|
(test (exists < '(1 2 4) '(2 3 4)) #t)
|
|
(test (exists > '(1 2 3) '(2 3 4)) #f)
|
|
|
|
(test (filter even? '(3 1 4 1 5 9 2 6)) '(4 2 6))
|
|
|
|
(test/values (partition even? '(3 1 4 1 5 9 2 6)) '(4 2 6) '(3 1 1 5 9))
|
|
|
|
(test (fold-left + 0 '(1 2 3 4 5)) 15)
|
|
|
|
(test (fold-left (lambda (a e) (cons e a)) '()
|
|
'(1 2 3 4 5))
|
|
'(5 4 3 2 1))
|
|
|
|
(test (fold-left (lambda (count x)
|
|
(if (odd? x) (+ count 1) count))
|
|
0
|
|
'(3 1 4 1 5 9 2 6 5 3))
|
|
7)
|
|
(test (fold-left (lambda (max-len s)
|
|
(max max-len (string-length s)))
|
|
0
|
|
'("longest" "long" "longer"))
|
|
7)
|
|
|
|
(test (fold-left cons '(q) '(a b c)) '((((q) . a) . b) . c))
|
|
|
|
(test (fold-left + 0 '(1 2 3) '(4 5 6)) 21)
|
|
|
|
(test (fold-right + 0 '(1 2 3 4 5)) 15)
|
|
|
|
(test (fold-right cons '() '(1 2 3 4 5)) '(1 2 3 4 5))
|
|
|
|
(test (fold-right (lambda (x l)
|
|
(if (odd? x) (cons x l) l))
|
|
'()
|
|
'(3 1 4 1 5 9 2 6 5))
|
|
'(3 1 1 5 9 5))
|
|
|
|
(test (fold-right cons '(q) '(a b c)) '(a b c q))
|
|
|
|
(test (fold-right + 0 '(1 2 3) '(4 5 6)) 21)
|
|
|
|
(test (remp even? '(3 1 4 1 5 9 2 6 5)) '(3 1 1 5 9 5))
|
|
|
|
(test (remove 1 '(3 1 4 1 5 9 2 6 5)) '(3 4 5 9 2 6 5))
|
|
|
|
(test (remv 1 '(3 1 4 1 5 9 2 6 5)) '(3 4 5 9 2 6 5))
|
|
|
|
(test (remq 'foo '(bar foo baz)) '(bar baz))
|
|
|
|
(test (memp even? '(3 1 4 1 5 9 2 6 5)) '(4 1 5 9 2 6 5))
|
|
|
|
(test (memq 'a '(a b c)) '(a b c))
|
|
(test (memq 'b '(a b c)) '(b c))
|
|
(test (memq 'a '(b c d)) #f)
|
|
(test (memq (list 'a) '(b (a) c)) #f)
|
|
(test (member (list 'a) '(b (a) c)) '((a) c))
|
|
(test/unspec (memq 101 '(100 101 102)))
|
|
(test (memv 101 '(100 101 102)) '(101 102))
|
|
|
|
(let ([d '((3 a) (1 b) (4 c))])
|
|
(test (assp even? d) '(4 c))
|
|
(test (assp odd? d) '(3 a)))
|
|
|
|
(let ([e '((a 1) (b 2) (c 3))])
|
|
(test (assq 'a e) '(a 1))
|
|
(test (assq 'b e) '(b 2))
|
|
(test (assq 'd e) #f))
|
|
|
|
|
|
(test (assq (list 'a) '(((a)) ((b)) ((c))))
|
|
#f)
|
|
(test (assoc (list 'a) '(((a)) ((b)) ((c))))
|
|
'((a)))
|
|
(test/unspec (assq 5 '((2 3) (5 7) (11 13))))
|
|
(test (assv 5 '((2 3) (5 7) (11 13))) '(5 7))
|
|
|
|
(test (cons* 1 2 '(3 4 5)) '(1 2 3 4 5))
|
|
(test (cons* 1 2 3) '(1 2 . 3))
|
|
(test (cons* 1) 1)
|
|
|
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Tests originally from Ikarus
|
|
|
|
(test (for-all even? '(1 2 3 4)) #f)
|
|
(test (for-all even? '(10 12 14 16)) #t)
|
|
(test (for-all even? '(2 3 4)) #f)
|
|
(test (for-all even? '(12 14 16)) #t)
|
|
(test (for-all (lambda (x) x) '(12 14 16)) 16)
|
|
(test (for-all (lambda (x) x) '(12 14)) 14)
|
|
(test (for-all (lambda (x) x) '(12)) 12)
|
|
(test (for-all (lambda (x) x) '()) #t)
|
|
;; (test (for-all even? '(13 . 14)) #f) ; removed from R6RS
|
|
(test (for-all cons '(1 2 3) '(a b c)) '(3 . c))
|
|
(test (for-all (lambda (a b) (= a 1)) '(1 2 3) '(a b c)) #f)
|
|
;; R6RS merely says that this *should* work, but not must:
|
|
;; (test (for-all (lambda (a b) (= a 1)) '(1 2) '(a b c)) #f)
|
|
(test (fold-left + 0 '(1 2 3 4 5)) 15)
|
|
(test (fold-left (lambda (a b) (cons b a)) '() '(1 2 3 4 5))
|
|
'(5 4 3 2 1))
|
|
(test (fold-left (lambda (count x)
|
|
(if (odd? x)
|
|
(+ count 1)
|
|
count))
|
|
0
|
|
'(3 1 4 1 5 9 2 6 5 3))
|
|
7)
|
|
(test (fold-left cons '(q) '(a b c)) '((((q) . a) . b) . c))
|
|
(test (fold-left + 0 '(1 2 3) '(4 5 6)) 21)
|
|
(test (fold-right + 0 '(1 2 3 4 5)) 15)
|
|
(test (fold-right cons '() '(1 2 3 4 5))
|
|
'(1 2 3 4 5))
|
|
(test (fold-right (lambda (x l)
|
|
(if (odd? x)
|
|
(cons x l)
|
|
l))
|
|
'()
|
|
'(3 1 4 1 5 9 2 6 5 3))
|
|
'(3 1 1 5 9 5 3))
|
|
(test (fold-right + 0 '(1 2 3) '(4 5 6)) 21)
|
|
|
|
;;
|
|
))
|