mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-19 21:59:17 +02:00
8b5eb68238
They can be close()d explicitly with close-file-descriptor, and will close() on gc, but only explicitly closing the last port on them will close the fileno. Notably needed for network sockets where we open separate input and output ports on the same socket.
162 lines
7.1 KiB
Scheme
162 lines
7.1 KiB
Scheme
(import (chibi) (chibi test) (srfi 1))
|
|
|
|
(test-begin "srfi-1")
|
|
|
|
;; srfi-1 examples
|
|
;; http://srfi.schemers.org/srfi-1/srfi-1.html
|
|
(test '(a) (cons 'a '()))
|
|
(test '((a) b c d) (cons '(a) '(b c d)))
|
|
(test '("a" b c) (cons "a" '(b c)))
|
|
(test '(a . 3) (cons 'a 3))
|
|
(test '((a b) . c) (cons '(a b) 'c))
|
|
(test '(a 7 c) (list 'a (+ 3 4) 'c))
|
|
(test '() (list))
|
|
(test '(a b c) (xcons '(b c) 'a))
|
|
(test '(1 2 3 . 4) (cons* 1 2 3 4))
|
|
(test '1 (cons* 1))
|
|
(test '(c c c c) (make-list 4 'c))
|
|
(test '(0 1 2 3) (list-tabulate 4 values))
|
|
(test '(z q z q z q) (take (circular-list 'z 'q) 6))
|
|
(test '(0 1 2 3 4) (iota 5))
|
|
(test '(0 -0.1 -0.2 -0.3 -0.4)
|
|
(let ((res (iota 5 0 -0.1)))
|
|
(cons (inexact->exact (car res)) (cdr res))))
|
|
(test '#t (pair? '(a . b)))
|
|
(test '#t (pair? '(a b c)))
|
|
(test '#f (pair? '()))
|
|
(test '#f (pair? '#(a b)))
|
|
(test '#f (pair? 7))
|
|
(test '#f (pair? 'a))
|
|
(test '#t (list= eq?))
|
|
(test '#t (list= eq? '(a)))
|
|
(test 'a (car '(a b c)))
|
|
(test '(b c) (cdr '(a b c)))
|
|
(test '(a) (car '((a) b c d)))
|
|
(test '(b c d) (cdr '((a) b c d)))
|
|
(test '1 (car '(1 . 2)))
|
|
(test '2 (cdr '(1 . 2)))
|
|
(test-error (car '()))
|
|
(test-error (cdr '()))
|
|
(test 'c (list-ref '(a b c d) 2))
|
|
(test 'c (third '(a b c d e)))
|
|
(test '(a b) (take '(a b c d e) 2))
|
|
(test '(c d e) (drop '(a b c d e) 2))
|
|
(test '(1 2) (take '(1 2 3 . d) 2))
|
|
(test '(3 . d) (drop '(1 2 3 . d) 2))
|
|
(test '(1 2 3) (take '(1 2 3 . d) 3))
|
|
(test 'd (drop '(1 2 3 . d) 3))
|
|
(test '(d e) (take-right '(a b c d e) 2))
|
|
(test '(a b c) (drop-right '(a b c d e) 2))
|
|
(test '(2 3 . d) (take-right '(1 2 3 . d) 2))
|
|
(test '(1) (drop-right '(1 2 3 . d) 2))
|
|
(test 'd (take-right '(1 2 3 . d) 0))
|
|
(test '(1 2 3) (drop-right '(1 2 3 . d) 0))
|
|
(test-assert (member (take! (circular-list 1 3 5) 8) '((1 3) (1 3 5 1 3 5 1 3)) equal?))
|
|
(test-values (values '(a b c) '(d e f g h)) (split-at '(a b c d e f g h) 3))
|
|
(test 'c (last '(a b c)))
|
|
(test '(c) (last-pair '(a b c)))
|
|
(test '(x y) (append '(x) '(y)))
|
|
(test '(a b c d) (append '(a) '(b c d)))
|
|
(test '(a (b) (c)) (append '(a (b)) '((c))))
|
|
(test '(a b c . d) (append '(a b) '(c . d)))
|
|
(test 'a (append '() 'a))
|
|
(test '(x y) (append '(x y)))
|
|
(test '() (append))
|
|
(test '(c b a) (reverse '(a b c)))
|
|
(test '((e (f)) d (b c) a) (reverse '(a (b c) d (e (f)))))
|
|
(test '((one 1 odd) (two 2 even) (three 3 odd)) (zip '(one two three) '(1 2 3) '(odd even odd even odd even odd even)))
|
|
(test '((1) (2) (3)) (zip '(1 2 3)))
|
|
(test '((3 #f) (1 #t) (4 #f) (1 #t)) (zip '(3 1 4 1) (circular-list #f #t)))
|
|
(test-values (values '(1 2 3) '(one two three)) (unzip2 '((1 one) (2 two) (3 three))))
|
|
(test '3 (count even? '(3 1 4 1 5 9 2 5 6)))
|
|
(test '3 (count < '(1 2 4 8) '(2 4 6 8 10 12 14 16)))
|
|
(test '2 (count < '(3 1 4 1) (circular-list 1 10)))
|
|
(test '(c 3 b 2 a 1) (fold cons* '() '(a b c) '(1 2 3 4 5)))
|
|
(test '(a 1 b 2 c 3) (fold-right cons* '() '(a b c) '(1 2 3 4 5)))
|
|
(test '((a b c) (b c) (c)) (pair-fold-right cons '() '(a b c)))
|
|
(test '((a b c) (1 2 3) (b c) (2 3) (c) (3)) (pair-fold-right cons* '() '(a b c) '(1 2 3)))
|
|
(test '(b e h) (map cadr '((a b) (d e) (g h))))
|
|
(test '(1 4 27 256 3125) (map (lambda (n) (expt n n)) '(1 2 3 4 5)))
|
|
(test '(5 7 9) (map + '(1 2 3) '(4 5 6)))
|
|
(test-assert (member (let ((count 0)) (map (lambda (ignored) (set! count (+ count 1)) count) '(a b))) '((1 2) (2 1)) equal?))
|
|
(test '(4 1 5 1) (map + '(3 1 4 1) (circular-list 1 0)))
|
|
(test '#(0 1 4 9 16) (let ((v (make-vector 5))) (for-each (lambda (i) (vector-set! v i (* i i))) '(0 1 2 3 4)) v))
|
|
(test '(1 -1 3 -3 8 -8) (append-map (lambda (x) (list x (- x))) '(1 3 8)))
|
|
(test '(1 -1 3 -3 8 -8) (apply append (map (lambda (x) (list x (- x))) '(1 3 8))))
|
|
(test '(1 -1 3 -3 8 -8) (append-map! (lambda (x) (list x (- x))) '(1 3 8)))
|
|
(test '(1 -1 3 -3 8 -8) (apply append! (map (lambda (x) (list x (- x))) '(1 3 8))))
|
|
(test "pair-for-each-1" '((a b c) (b c) (c))
|
|
(let ((a '()))
|
|
(pair-for-each (lambda (x) (set! a (cons x a))) '(a b c))
|
|
(reverse a)))
|
|
(test '(1 9 49) (filter-map (lambda (x) (and (number? x) (* x x))) '(a 1 b 3 c 7)))
|
|
(test '(0 8 8 -4) (filter even? '(0 7 8 8 43 -4)))
|
|
(test-values (values '(one four five) '(2 3 6)) (partition symbol? '(one 2 3 four five 6)))
|
|
(test '(7 43) (remove even? '(0 7 8 8 43 -4)))
|
|
(test '2 (find even? '(1 2 3)))
|
|
(test '#t (any even? '(1 2 3)))
|
|
(test '#f (find even? '(1 7 3)))
|
|
(test '#f (any even? '(1 7 3)))
|
|
;(test-error (find even? '(1 3 . x)))
|
|
(test-error (any even? '(1 3 . x)))
|
|
;(test 'error/undefined (find even? '(1 2 . x)))
|
|
;(test 'error/undefined (any even? '(1 2 . x))) ; success, error or other
|
|
(test '6 (find even? (circular-list 1 6 3)))
|
|
(test '#t (any even? (circular-list 1 6 3)))
|
|
;(test-error (find even? (circular-list 1 3))) ; divergent
|
|
;(test-error (any even? (circular-list 1 3))) ; divergent
|
|
(test '4 (find even? '(3 1 4 1 5 9)))
|
|
(test '(-8 -5 0 0) (find-tail even? '(3 1 37 -8 -5 0 0)))
|
|
(test '#f (find-tail even? '(3 1 37 -5)))
|
|
(test '(2 18) (take-while even? '(2 18 3 10 22 9)))
|
|
(test '(3 10 22 9) (drop-while even? '(2 18 3 10 22 9)))
|
|
(test-values (values '(2 18) '(3 10 22 9)) (span even? '(2 18 3 10 22 9)))
|
|
(test-values (values '(3 1) '(4 1 5 9)) (break even? '(3 1 4 1 5 9)))
|
|
(test '#t (any integer? '(a 3 b 2.7)))
|
|
(test '#f (any integer? '(a 3.1 b 2.7)))
|
|
(test '#t (any < '(3 1 4 1 5) '(2 7 1 8 2)))
|
|
(test '2 (list-index even? '(3 1 4 1 5 9)))
|
|
(test '1 (list-index < '(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2)))
|
|
(test '#f (list-index = '(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2)))
|
|
(test '(a b c) (memq 'a '(a b c)))
|
|
(test '(b c) (memq 'b '(a b c)))
|
|
(test '#f (memq 'a '(b c d)))
|
|
(test '#f (memq (list 'a) '(b (a) c)))
|
|
(test '((a) c) (member (list 'a) '(b (a) c)))
|
|
;(test '*unspecified* (memq 101 '(100 101 102)))
|
|
(test '(101 102) (memv 101 '(100 101 102)))
|
|
(test '(a b c z) (delete-duplicates '(a b a c a b c z)))
|
|
(test '((a . 3) (b . 7) (c . 1)) (delete-duplicates '((a . 3) (b . 7) (a . 9) (c . 1)) (lambda (x y) (eq? (car x) (car y)))))
|
|
(let ((e '((a 1) (b 2) (c 3))))
|
|
(test '(a 1) (assq 'a e))
|
|
(test '(b 2) (assq 'b e))
|
|
(test '#f (assq 'd e))
|
|
(test '#f (assq (list 'a) '(((a)) ((b)) ((c)))))
|
|
(test '((a)) (assoc (list 'a) '(((a)) ((b)) ((c)))))
|
|
;(test '*unspecified* (assq 5 '((2 3) (5 7) (11 13))))
|
|
(test '(5 7) (assv 5 '((2 3) (5 7) (11 13)))))
|
|
(test '#t (lset<= eq? '(a) '(a b a) '(a b c c)))
|
|
(test '#t (lset<= eq?))
|
|
(test '#t (lset<= eq? '(a)))
|
|
(test '#t (lset= eq? '(b e a) '(a e b) '(e e b a)))
|
|
(test '#t (lset= eq?))
|
|
(test '#t (lset= eq? '(a)))
|
|
(test '(u o i a b c d c e) (lset-adjoin eq? '(a b c d c e) 'a 'e 'i 'o 'u))
|
|
(test '(u o i a b c d e) (lset-union eq? '(a b c d e) '(a e i o u)))
|
|
(test '(x a a c) (lset-union eq? '(a a c) '(x a x)))
|
|
(test '() (lset-union eq?))
|
|
(test '(a b c) (lset-union eq? '(a b c)))
|
|
(test '(a e) (lset-intersection eq? '(a b c d e) '(a e i o u)))
|
|
(test '(a x a) (lset-intersection eq? '(a x y a) '(x a x z)))
|
|
(test '(a b c) (lset-intersection eq? '(a b c)))
|
|
(test '(b c d) (lset-difference eq? '(a b c d e) '(a e i o u)))
|
|
(test '(a b c) (lset-difference eq? '(a b c)))
|
|
(test #t (lset= eq? '(d c b i o u) (lset-xor eq? '(a b c d e) '(a e i o u))))
|
|
(test '() (lset-xor eq?))
|
|
(test '(a b c d e) (lset-xor eq? '(a b c d e)))
|
|
(let ((f (lambda () (list 'not-a-constant-list)))
|
|
(g (lambda () '(constant-list))))
|
|
;(test '*unspecified* (set-car! (f) 3))
|
|
(test-error (set-car! (g) 3)))
|
|
|
|
(test-end)
|