Author: yamakenz
Date: Sun Jul 1 06:15:21 2007
New Revision: 4645
Modified:
sigscheme-trunk/lib/srfi-1.scm
sigscheme-trunk/test/test-srfi1-another.scm
Log:
* lib/srfi-1.scm
- (list=): Fix broken comparison on 3 or more lists
* test/test-srfi1-another.scm
- Add tests for list= and complete tests for predicates
Modified: sigscheme-trunk/lib/srfi-1.scm
==============================================================================
--- sigscheme-trunk/lib/srfi-1.scm (original)
+++ sigscheme-trunk/lib/srfi-1.scm Sun Jul 1 06:15:21 2007
@@ -17,6 +17,7 @@
;; 2007-06-30 yamaken - Fix broken arguments receiving of delete-duplicates!
;; - Fix broken lset-difference call of lset-xor and
;; lset-xor! (as like as Scheme48)
+;; 2007-07-01 yamaken - Fix broken comparison of list= on 3 or more lists
;;; This is a library of list- and pair-processing functions. I wrote it after
@@ -429,13 +430,13 @@
(others (cdr others)))
(if (eq? list-a list-b) ; EQ? => LIST=
(lp1 list-b others)
- (let lp2 ((list-a list-a) (list-b list-b))
- (if (null-list? list-a)
- (and (null-list? list-b)
+ (let lp2 ((tail-a list-a) (tail-b list-b))
+ (if (null-list? tail-a)
+ (and (null-list? tail-b)
(lp1 list-b others))
- (and (not (null-list? list-b))
- (= (car list-a) (car list-b))
- (lp2 (cdr list-a) (cdr list-b)))))))))))
+ (and (not (null-list? tail-b))
+ (= (car tail-a) (car tail-b))
+ (lp2 (cdr tail-a) (cdr tail-b)))))))))))
Modified: sigscheme-trunk/test/test-srfi1-another.scm
==============================================================================
--- sigscheme-trunk/test/test-srfi1-another.scm (original)
+++ sigscheme-trunk/test/test-srfi1-another.scm Sun Jul 1 06:15:21 2007
@@ -528,6 +528,136 @@
(assert-eq? (tn) #t (not-pair? (vector 0 1 2)))
;; list=
+(tn "list= SRFI-1 examples")
+(assert-eq? (tn) #t (list= eq?))
+(assert-eq? (tn) #t (list= eq? '(a)))
+(tn "list= 1 list")
+(assert-eq? (tn) #t (list= eq? '()))
+(assert-eq? (tn) #t (list= equal? '()))
+(assert-eq? (tn) #t (list= eq? lst))
+(assert-eq? (tn) #t (list= equal? lst))
+(assert-eq? (tn) #t (list= eq? (list elm0)))
+(assert-eq? (tn) #t (list= equal? (list elm0)))
+(assert-eq? (tn) #t (list= equal? '("a" "b" "c")))
+(assert-eq? (tn) #t (list= equal? (list "a" "b" "c")))
+(tn "list= 2 lists")
+(assert-eq? (tn) #t (list= eq? '() '()))
+(assert-eq? (tn) #t (list= equal? '() '()))
+(assert-eq? (tn) #t (list= eq? lst lst))
+(assert-eq? (tn) #t (list= equal? lst lst))
+(assert-eq? (tn) #t (list= eq? (list elm0) (list elm0)))
+(assert-eq? (tn) #t (list= equal? (list elm0) (list elm0)))
+(assert-eq? (tn) #t (list= eq? (list elm0 elm1) (list elm0 elm1)))
+(assert-eq? (tn) #t (list= equal? (list elm0 elm1) (list elm0 elm1)))
+(assert-eq? (tn) #t (list= eq? (list elm0 elm1 elm2) (list elm0 elm1 elm2)))
+(assert-eq? (tn) #t (list= equal? (list elm0 elm1 elm2) (list elm0 elm1 elm2)))
+(assert-eq? (tn) #t (list= equal? '("a" "b" "c") '("a" "b" "c")))
+(assert-eq? (tn) #t (list= equal? (list "a" "b" "c") (list "a" "b" "c")))
+(tn "list= 2 lists unequal length")
+(assert-eq? (tn) #f (list= eq? (list elm0 elm1) (list elm0 elm1 elm2)))
+(assert-eq? (tn) #f (list= equal? (list elm0 elm1) (list elm0 elm1 elm2)))
+(assert-eq? (tn) #f (list= eq? (list elm0 elm1 elm2) (list elm0 elm1)))
+(assert-eq? (tn) #f (list= equal? (list elm0 elm1 elm2) (list elm0 elm1)))
+(assert-eq? (tn) #f (list= eq? '() (list elm0 elm1 elm2)))
+(assert-eq? (tn) #f (list= equal? '() (list elm0 elm1 elm2)))
+(assert-eq? (tn) #f (list= eq? (list elm0 elm1 elm2) '()))
+(assert-eq? (tn) #f (list= equal? (list elm0 elm1 elm2) '()))
+(tn "list= 3 lists")
+(assert-eq? (tn) #t (list= eq? '() '() '()))
+(assert-eq? (tn) #t (list= equal? '() '() '()))
+(assert-eq? (tn) #t (list= eq? lst lst lst))
+(assert-eq? (tn) #t (list= equal? lst lst lst))
+(assert-eq? (tn) #t (list= eq? (list elm0) (list elm0) (list elm0)))
+(assert-eq? (tn) #t (list= equal? (list elm0) (list elm0) (list elm0)))
+(assert-eq? (tn) #t (list= eq? (list elm0 elm1) (list elm0 elm1)
+ (list elm0 elm1)))
+(assert-eq? (tn) #t (list= equal? (list elm0 elm1) (list elm0 elm1)
+ (list elm0 elm1)))
+(assert-eq? (tn) #t (list= eq? (list elm0 elm1 elm2) (list elm0 elm1 elm2)
+ (list elm0 elm1 elm2)))
+(assert-eq? (tn) #t (list= equal? (list elm0 elm1 elm2) (list elm0 elm1 elm2)
+ (list elm0 elm1 elm2)))
+(assert-eq? (tn) #t (list= equal? '("a" "b" "c") '("a" "b" "c")
+ '("a" "b" "c")))
+;; This test is failed on the original srfi-1-reference.scm
+(assert-eq? (tn) #t (list= equal? (list "a" "b" "c") (list "a" "b" "c")
+ (list "a" "b" "c")))
+(tn "list= 3 lists unequal length")
+(assert-eq? (tn) #f (list= eq? (list elm0 elm1) (list elm0 elm1 elm2)
+ (list elm0 elm1 elm2)))
+(assert-eq? (tn) #f (list= equal? (list elm0 elm1) (list elm0 elm1 elm2)
+ (list elm0 elm1 elm2)))
+(assert-eq? (tn) #f (list= eq? (list elm0 elm1 elm2) (list elm0 elm1)
+ (list elm0 elm1 elm2)))
+(assert-eq? (tn) #f (list= equal? (list elm0 elm1 elm2) (list elm0 elm1)
+ (list elm0 elm1 elm2)))
+(assert-eq? (tn) #f (list= eq? (list elm0 elm1 elm2) (list elm0 elm1 elm2)
+ (list elm0 elm1)))
+(assert-eq? (tn) #f (list= equal? (list elm0 elm1 elm2) (list elm0 elm1 elm2)
+ (list elm0 elm1)))
+(assert-eq? (tn) #f (list= eq? '() (list elm0 elm1 elm2)
+ (list elm0 elm1 elm2)))
+(assert-eq? (tn) #f (list= equal? '() (list elm0 elm1 elm2)
+ (list elm0 elm1 elm2)))
+(assert-eq? (tn) #f (list= eq? (list elm0 elm1 elm2) '()
+ (list elm0 elm1 elm2)))
+(assert-eq? (tn) #f (list= equal? (list elm0 elm1 elm2) '()
+ (list elm0 elm1 elm2)))
+(assert-eq? (tn) #f (list= eq? (list elm0 elm1 elm2) (list elm0 elm1 elm2)
+ '()))
+(assert-eq? (tn) #f (list= equal? (list elm0 elm1 elm2) (list elm0 elm1 elm2)
+ '()))
+(tn "list= 4 lists")
+(assert-eq? (tn) #t (list= eq? '() '() '() '()))
+(assert-eq? (tn) #t (list= equal? '() '() '() '()))
+(assert-eq? (tn) #t (list= eq? lst lst lst lst))
+(assert-eq? (tn) #t (list= equal? lst lst lst lst))
+(assert-eq? (tn) #t (list= eq? (list elm0) (list elm0)
+ (list elm0) (list elm0)))
+(assert-eq? (tn) #t (list= equal? (list elm0) (list elm0)
+ (list elm0) (list elm0)))
+(assert-eq? (tn) #t (list= eq? (list elm0 elm1) (list elm0 elm1)
+ (list elm0 elm1) (list elm0 elm1)))
+(assert-eq? (tn) #t (list= equal? (list elm0 elm1) (list elm0 elm1)
+ (list elm0 elm1) (list elm0 elm1)))
+(assert-eq? (tn) #t (list= eq? (list elm0 elm1 elm2) (list elm0 elm1 elm2)
+ (list elm0 elm1 elm2) (list elm0 elm1 elm2)))
+(assert-eq? (tn) #t (list= equal? (list elm0 elm1 elm2) (list elm0 elm1 elm2)
+ (list elm0 elm1 elm2) (list elm0 elm1 elm2)))
+(assert-eq? (tn) #t (list= equal? '("a" "b" "c") '("a" "b" "c")
+ '("a" "b" "c") '("a" "b" "c")))
+;; This test is failed on the original srfi-1-reference.scm
+(assert-eq? (tn) #t (list= equal? (list "a" "b" "c") (list "a" "b" "c")
+ (list "a" "b" "c") (list "a" "b" "c")))
+(tn "list= 4 lists unequal length")
+(assert-eq? (tn) #f (list= eq? (list elm0 elm1) (list elm0 elm1 elm2)
+ (list elm0 elm1 elm2) (list elm0 elm1 elm2)))
+(assert-eq? (tn) #f (list= equal? (list elm0 elm1) (list elm0 elm1 elm2)
+ (list elm0 elm1 elm2) (list elm0 elm1 elm2)))
+(assert-eq? (tn) #f (list= eq? (list elm0 elm1 elm2) (list elm0 elm1)
+ (list elm0 elm1 elm2) (list elm0 elm1 elm2)))
+(assert-eq? (tn) #f (list= equal? (list elm0 elm1 elm2) (list elm0 elm1)
+ (list elm0 elm1 elm2) (list elm0 elm1 elm2)))
+(assert-eq? (tn) #f (list= eq? (list elm0 elm1 elm2) (list elm0 elm1 elm2)
+ (list elm0 elm1) (list elm0 elm1 elm2)))
+(assert-eq? (tn) #f (list= equal? (list elm0 elm1 elm2) (list elm0 elm1 elm2)
+ (list elm0 elm1) (list elm0 elm1 elm2)))
+(assert-eq? (tn) #f (list= eq? '() (list elm0 elm1 elm2)
+ (list elm0 elm1 elm2) (list elm0 elm1 elm2)))
+(assert-eq? (tn) #f (list= equal? '() (list elm0 elm1 elm2)
+ (list elm0 elm1 elm2) (list elm0 elm1 elm2)))
+(assert-eq? (tn) #f (list= eq? (list elm0 elm1 elm2) '()
+ (list elm0 elm1 elm2) (list elm0 elm1 elm2)))
+(assert-eq? (tn) #f (list= equal? (list elm0 elm1 elm2) '()
+ (list elm0 elm1 elm2) (list elm0 elm1 elm2)))
+(assert-eq? (tn) #f (list= eq? (list elm0 elm1 elm2) (list elm0 elm1 elm2)
+ '() (list elm0 elm1 elm2)))
+(assert-eq? (tn) #f (list= equal? (list elm0 elm1 elm2) (list elm0 elm1 elm2)
+ '() (list elm0 elm1 elm2)))
+(assert-eq? (tn) #f (list= eq? (list elm0 elm1 elm2) (list elm0 elm1 elm2)
+ (list elm0 elm1 elm2) '()))
+(assert-eq? (tn) #f (list= equal? (list elm0 elm1 elm2) (list elm0 elm1 elm2)
+ (list elm0 elm1 elm2) '()))
;;
