mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-10 11:20:28 +02:00
Code Activity

(lset=): New tests.

Browse source
This commit is contained in:
Kevin Ryde 2005-01-27 23:20:14 +00:00
parent cafbb8c05d
commit a9c3bff968
1 changed files with 64 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

65
test-suite/tests/srfi-1.test
View file

@ -646,7 +646,70 @@
;; in guile 1.6.7 and earlier, lset= incorrectly demanded at least one
;; list arg
(pass-if "no args"
(eq? #t (lset= eq?))))
(eq? #t (lset= eq?)))
(with-test-prefix "one arg"
(pass-if "()"
(eq? #t (lset= eqv? '())))
(pass-if "(1)"
(eq? #t (lset= eqv? '(1))))
(pass-if "(1 2)"
(eq? #t (lset= eqv? '(1 2)))))
(with-test-prefix "two args"
(pass-if "() ()"
(eq? #t (lset= eqv? '() '())))
(pass-if "(1) (1)"
(eq? #t (lset= eqv? '(1) '(1))))
(pass-if "(1) (2)"
(eq? #f (lset= eqv? '(1) '(2))))
(pass-if "(1) (1 2)"
(eq? #f (lset= eqv? '(1) '(1 2))))
(pass-if "(1 2) (2 1)"
(eq? #t (lset= eqv? '(1 2) '(2 1))))
(pass-if "called arg order"
(let ((good #t))
(lset= (lambda (x y)
(if (not (= x (1- y)))
(set! good #f))
#t)
'(1 1) '(2 2))
good)))
(with-test-prefix "three args"
(pass-if "() () ()"
(eq? #t (lset= eqv? '() '() '())))
(pass-if "(1) (1) (1)"
(eq? #t (lset= eqv? '(1) '(1) '(1))))
(pass-if "(1) (1) (2)"
(eq? #f (lset= eqv? '(1) '(1) '(2))))
(pass-if "(1) (1) (1 2)"
(eq? #f (lset= eqv? '(1) '(1) '(1 2))))
(pass-if "(1 2 3) (3 2 1) (1 3 2)"
(eq? #t (lset= eqv? '(1 2 3) '(3 2 1) '(1 3 2))))
(pass-if "called arg order"
(let ((good #t))
(lset= (lambda (x y)
(if (not (= x (1- y)))
(set! good #f))
#t)
'(1 1) '(2 2) '(3 3))
good))))
;;
;; map