Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 13:49:17 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Fixing a long-standing typo in lset<=.

Browse source 
Fixes issue #224.
This commit is contained in:
Alex Shinn 2014-06-20 07:56:39 +09:00
parent 695e99c076
commit bbd8827bb2
2 changed files with 43 additions and 38 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
lib/srfi/1/lset.scm
View file

@ -11,7 +11,7 @@
(let ((set2 (car sets))) (let ((set2 (car sets)))
(let lp2 ((ls set1)) (let lp2 ((ls set1))
(if (pair? ls) (if (pair? ls)
(and (member (car set1) set2 eq) (lp2 (cdr ls))) (and (member (car ls) set2 eq) (lp2 (cdr ls)))
(lp1 set2 (cdr sets))))))))) (lp1 set2 (cdr sets)))))))))
(define (lset= eq . sets) (define (lset= eq . sets)

79
tests/srfi-1-tests.scm
View file

@ -13,7 +13,7 @@
(test '() (list)) (test '() (list))
(test '(a b c) (xcons '(b c) 'a)) (test '(a b c) (xcons '(b c) 'a))
(test '(1 2 3 . 4) (cons* 1 2 3 4)) (test '(1 2 3 . 4) (cons* 1 2 3 4))
(test '1 (cons* 1)) (test 1 (cons* 1))
(test '(c c c c) (make-list 4 'c)) (test '(c c c c) (make-list 4 'c))
(test '(0 1 2 3) (list-tabulate 4 values)) (test '(0 1 2 3) (list-tabulate 4 values))
(test '(z q z q z q) (take (circular-list 'z 'q) 6)) (test '(z q z q z q) (take (circular-list 'z 'q) 6))
@ -21,14 +21,14 @@
(test '(0 -0.1 -0.2 -0.3 -0.4) (test '(0 -0.1 -0.2 -0.3 -0.4)
(let ((res (iota 5 0 -0.1))) (let ((res (iota 5 0 -0.1)))
(cons (inexact->exact (car res)) (cdr res)))) (cons (inexact->exact (car res)) (cdr res))))
(test '#t (pair? '(a . b))) (test #t (pair? '(a . b)))
(test '#t (pair? '(a b c))) (test #t (pair? '(a b c)))
(test '#f (pair? '())) (test #f (pair? '()))
(test '#f (pair? '#(a b))) (test #f (pair? '#(a b)))
(test '#f (pair? 7)) (test #f (pair? 7))
(test '#f (pair? 'a)) (test #f (pair? 'a))
(test '#t (list= eq?)) (test #t (list= eq?))
(test '#t (list= eq? '(a))) (test #t (list= eq? '(a)))
(test 'a (car '(a b c))) (test 'a (car '(a b c)))
(test '(b c) (cdr '(a b c))) (test '(b c) (cdr '(a b c)))
(test '(a) (car '((a) b c d))) (test '(a) (car '((a) b c d)))
@ -68,9 +68,9 @@
(test '((1) (2) (3)) (zip '(1 2 3))) (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 '((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-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 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 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 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 '(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 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) (b c) (c)) (pair-fold-right cons '() '(a b c)))
@ -93,21 +93,21 @@
(test '(0 8 8 -4) (filter even? '(0 7 8 8 43 -4))) (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-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 '(7 43) (remove even? '(0 7 8 8 43 -4)))
(test '2 (find even? '(1 2 3))) (test 2 (find even? '(1 2 3)))
(test '#t (any even? '(1 2 3))) (test #t (any even? '(1 2 3)))
(test '#f (find even? '(1 7 3))) (test #f (find even? '(1 7 3)))
(test '#f (any even? '(1 7 3))) (test #f (any even? '(1 7 3)))
;(test-error (find even? '(1 3 . x))) ;(test-error (find even? '(1 3 . x)))
(test-error (any even? '(1 3 . x))) (test-error (any even? '(1 3 . x)))
;(test 'error/undefined (find even? '(1 2 . x))) ;(test 'error/undefined (find even? '(1 2 . x)))
;(test 'error/undefined (any even? '(1 2 . x))) ; success, error or other ;(test 'error/undefined (any even? '(1 2 . x))) ; success, error or other
(test '6 (find even? (circular-list 1 6 3))) (test 6 (find even? (circular-list 1 6 3)))
(test '#t (any 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 (find even? (circular-list 1 3))) ; divergent
;(test-error (any 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 4 (find even? '(3 1 4 1 5 9)))
(test '#f (every odd? '(1 2 3))) (test #f (every odd? '(1 2 3)))
(test '#t (every < '(1 2 3) '(4 5 6))) (test #t (every < '(1 2 3) '(4 5 6)))
(test-error (every odd? '(1 3 . x))) (test-error (every odd? '(1 3 . x)))
(test '(-8 -5 0 0) (find-tail even? '(3 1 37 -8 -5 0 0))) (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 '#f (find-tail even? '(3 1 37 -5)))
@ -115,16 +115,16 @@
(test '(3 10 22 9) (drop-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 '(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-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 #t (any integer? '(a 3 b 2.7)))
(test '#f (any integer? '(a 3.1 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 #t (any < '(3 1 4 1 5) '(2 7 1 8 2)))
(test '2 (list-index even? '(3 1 4 1 5 9))) (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 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 #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 '(a b c) (memq 'a '(a b c)))
(test '(b c) (memq 'b '(a b c))) (test '(b c) (memq 'b '(a b c)))
(test '#f (memq 'a '(b c d))) (test #f (memq 'a '(b c d)))
(test '#f (memq (list 'a) '(b (a) c))) (test #f (memq (list 'a) '(b (a) c)))
(test '((a) c) (member (list 'a) '(b (a) c))) (test '((a) c) (member (list 'a) '(b (a) c)))
;(test '*unspecified* (memq 101 '(100 101 102))) ;(test '*unspecified* (memq 101 '(100 101 102)))
(test '(101 102) (memv 101 '(100 101 102))) (test '(101 102) (memv 101 '(100 101 102)))
@ -133,17 +133,22 @@
(let ((e '((a 1) (b 2) (c 3)))) (let ((e '((a 1) (b 2) (c 3))))
(test '(a 1) (assq 'a e)) (test '(a 1) (assq 'a e))
(test '(b 2) (assq 'b e)) (test '(b 2) (assq 'b e))
(test '#f (assq 'd e)) (test #f (assq 'd e))
(test '#f (assq (list 'a) '(((a)) ((b)) ((c))))) (test #f (assq (list 'a) '(((a)) ((b)) ((c)))))
(test '((a)) (assoc (list 'a) '(((a)) ((b)) ((c))))) (test '((a)) (assoc (list 'a) '(((a)) ((b)) ((c)))))
;(test '*unspecified* (assq 5 '((2 3) (5 7) (11 13)))) ;(test '*unspecified* (assq 5 '((2 3) (5 7) (11 13))))
(test '(5 7) (assv 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? '(a) '(a b a) '(a b c c)))
(test '#t (lset<= eq?)) (test #t (lset<= eq?))
(test '#t (lset<= eq? '(a))) (test #t (lset<= eq? '(a)))
(test '#t (lset= eq? '(b e a) '(a e b) '(e e b a))) (test #f (lset= eq? '(a) '()))
(test '#t (lset= eq?)) (test #f (lset= eq? '() '(a)))
(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 #f (lset= = '(2 1) '(2 1 0)))
(test #t (lset<= = '(2 1) '(2 1 0)))
(test #f (lset<= = '(2 1 0) '(2 1)))
(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 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 '(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 '(x a a c) (lset-union eq? '(a a c) '(x a x)))