Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +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 lp2 ((ls set1))
(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)))))))))
(define (lset= eq . sets)

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

@ -13,7 +13,7 @@
(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 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))
@ -21,14 +21,14 @@
(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 #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)))
@ -68,9 +68,9 @@
(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 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)))
@ -93,21 +93,21 @@
(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 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 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 '#f (every odd? '(1 2 3)))
(test '#t (every < '(1 2 3) '(4 5 6)))
(test 4 (find even? '(3 1 4 1 5 9)))
(test #f (every odd? '(1 2 3)))
(test #t (every < '(1 2 3) '(4 5 6)))
(test-error (every odd? '(1 3 . x)))
(test '(-8 -5 0 0) (find-tail even? '(3 1 37 -8 -5 0 0)))
(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-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 #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 #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)))
@ -133,17 +133,22 @@
(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 #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 #t (lset<= eq? '(a) '(a b a) '(a b c c)))
(test #t (lset<= eq?))
(test #t (lset<= eq? '(a)))
(test #f (lset= eq? '(a) '()))
(test #f (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 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)))