X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Flist.pure.lisp;h=7ccdf3c1d2a757062f29c4fa583b7c30bd415f36;hb=062283b901155792f65775491aea51481c56faaa;hp=921500df3113d90e6da840e3e68f253a054fc1b8;hpb=f24a665895283c52443ed45bb3e07530f760bbfa;p=sbcl.git diff --git a/tests/list.pure.lisp b/tests/list.pure.lisp index 921500d..7ccdf3c 100644 --- a/tests/list.pure.lisp +++ b/tests/list.pure.lisp @@ -183,7 +183,6 @@ (test nil (member -1.0 numbers :key #'- :test 'eql)))) ;;; assoc - (macrolet ((test (expected form) (let ((numbers '((1 a) (2 b))) (tricky '(nil (a . b) nil (nil . c) (c . d)))) @@ -229,6 +228,96 @@ ;; alist (test (nil . c) (assoc nil tricky :test #'eq)))) +;;; rassoc +(macrolet ((test (expected form) + (let ((numbers '((a . 1) (b . 2))) + (tricky '(nil (b . a) nil (c . nil) (d . c)))) + `(progn + (assert (equal ',expected (let ((numbers ',numbers) + (tricky ',tricky)) + (funcall fun ,@(cdr form))))) + (assert (equal ',expected (funcall (lambda () + (declare (optimize speed)) + (let ((numbers ',numbers) + (tricky ',tricky)) + ,form))))) + (assert (equal ',expected (funcall (lambda () + (declare (optimize space)) + (let ((numbers ',numbers) + (tricky ',tricky)) + ,form))))))))) + (let ((fun (car (list 'rassoc)))) + (test (a . 1) (rassoc 1 numbers)) + (test (b . 2) (rassoc 2 numbers)) + (test (a . 1) (rassoc 1 numbers :key 'identity)) + (test (b . 2) (rassoc 2 numbers :key #'identity)) + (test nil (rassoc 1.0 numbers)) + + (test (a . 1) (rassoc 1.0 numbers :test #'=)) + (test (a . 1) (rassoc 1.0 numbers :test #'= :key nil)) + (test (b . 2) (rassoc 2.0 numbers :test '=)) + (test nil (rassoc 0 numbers :test '=)) + + (test (a . 1) (rassoc 0 numbers :test-not #'>)) + (test (b . 2) (rassoc 1 numbers :test-not 'eql)) + (test nil (rassoc 0 numbers :test-not '<)) + + (test (a . 1) (rassoc -1 numbers :key #'-)) + (test (b . 2) (rassoc -2 numbers :key '-)) + (test nil (rassoc -1.0 numbers :key #'-)) + + (test (a . 1) (rassoc -1.0 numbers :key #'- :test '=)) + (test (b . 2) (rassoc -2.0 numbers :key #'- :test '=)) + (test nil (rassoc -1.0 numbers :key #'- :test 'eql)) + + (test (c . nil) (rassoc nil tricky :test #'eq)))) + +;;;; member-if & assoc-if & rassoc-if +(macrolet ((test (value form) + `(let ((* ,value)) + (assert (eval ,form)) + (assert (funcall (compile nil (lambda () ,form))))))) + (test 'evenp + (equal '(2 3 4) (member-if * (list 1 2 3 4)))) + (test 'evenp + (equal '(2 3 4) (locally (declare (optimize speed)) + (member-if * '(1 2 3 4))))) + (test 'evenp + (equal '(3 4) (member-if * (list 1 2 3 4) :key (lambda (x) (if (= 3 x) 2 1))))) + (test 'evenp + (equal '(2 :two) (assoc-if * (list (list 1 :one) (list 3 :three) (list 2 :two) (list 4 :four))))) + (test 'evenp + (equal '(3 :three) (assoc-if * (list (list 1 :one) (list 3 :three) (list 2 :two) (list 4 :four)) + :key (lambda (x) (if (= 3 x) 2 1))))) + (test 'evenp + (equal '(:two . 2) (rassoc-if * (list '(:one . 1) '(:three . 3) '(:two . 2) '(:four . 4))))) + (test (list 1 2 3 4) + (equal '(2 3 4) (member-if 'evenp *))) + (test (list (cons 1 'a) (cons 2 'b) (cons 3 'c)) + (equal (cons 2 'b) (assoc-if 'evenp *)))) + +;;;; member-if-not & assoc-if-not +(macrolet ((test (value form) + `(let ((* ,value)) + (assert (eval ,form)) + (assert (funcall (compile nil (lambda () ,form))))))) + (test 'oddp + (equal '(2 3 4) (member-if-not * (list 1 2 3 4)))) + (test 'oddp + (equal '(2 3 4) (locally (declare (optimize speed)) + (member-if-not * '(1 2 3 4))))) + (test 'oddp + (equal '(3 4) (member-if-not * (list 1 2 3 4) :key (lambda (x) (if (= 3 x) 2 1))))) + (test 'oddp + (equal '(2 :two) (assoc-if-not * (list (list 1 :one) (list 3 :three) (list 2 :two) (list 4 :four))))) + (test 'oddp + (equal '(3 :three) (assoc-if-not * (list (list 1 :one) (list 3 :three) (list 2 :two) (list 4 :four)) + :key (lambda (x) (if (= 3 x) 2 1))))) + (test (list 1 2 3 4) + (equal '(2 3 4) (member-if-not 'oddp *))) + (test (list (cons 1 'a) (cons 2 'b) (cons 3 'c)) + (equal (cons 2 'b) (assoc-if-not 'oddp *)))) + ;;; bug reported by Dan Corkill: *PRINT-CASE* affected the compiler transforms ;;; for ASSOC & MEMBER (let ((*print-case* :downcase)) @@ -247,6 +336,7 @@ (assert (equal '((:b)) (funcall (compile nil '(lambda (x y) (adjoin x y :key #'car :test #'string=))) (list 'b) (list '(:b))))) +#+sb-eval (assert (equal '((:b)) (let ((sb-ext:*evaluator-mode* :interpret)) (eval '(adjoin (list 'b) (list '(:b)) :key #'car :test #'string=))))) @@ -262,3 +352,28 @@ (declare (optimize speed)) (adjoin elt '(:y)))) ':x))) +(assert (equal '(a) (funcall (compile nil '(lambda () (adjoin 'a nil)))))) + +(macrolet ((test (expected list-1 list-2 &rest args) + `(progn + (assert (equal ,expected (funcall #'union ,list-1 ,list-2 ,@args))) + (assert (equal ,expected (funcall #'nunion + (copy-list ,list-1) + (copy-list ,list-2) + ,@args)))))) + (test nil nil nil) + (test '(42) nil '(42)) + (test '(42) '(42) nil) + (test '(42) '(42) '(42)) + (test '((42) (42)) '((42)) '((42))) + (test '((42) (42)) '((42)) '((42)) :test-not #'equal) + (test '((42)) '((42)) '((42)) :test #'equal) + (test '((42)) '((42)) '((42)) :key #'car) + (test '((42)) '((42)) '((42)) :key #'car :test-not #'<)) + +;;; FIND on lists should not call key outside the specified subsquence. +(assert (not (find :a '(0 (:c) 1) :start 1 :end 2 :key #'car))) + +(with-test (:name :adjoin-folding) + (flet ((%f () (adjoin 'x '(a b)))) + (assert (not (eq (%f) (%f))))))