X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Flist.pure.lisp;h=7ccdf3c1d2a757062f29c4fa583b7c30bd415f36;hb=a189a69454ef7635149319ae213b337f17c50d20;hp=afc5c6b7c6c14542ea03f0e65f0e722836a9e44e;hpb=961c7076f5fba67ddba0e12dd131104834348b1a;p=sbcl.git diff --git a/tests/list.pure.lisp b/tests/list.pure.lisp index afc5c6b..7ccdf3c 100644 --- a/tests/list.pure.lisp +++ b/tests/list.pure.lisp @@ -130,6 +130,9 @@ (assert (null (butlast s (* 1440 most-positive-fixnum)))) (assert (null (nbutlast s (* 1440 most-positive-fixnum))))) +(assert (eq :atom (last (list* 1 2 3 :atom) (eval 0)))) +(assert (eq :atom (last (list* 1 2 3 :atom) 0))) + ;;; enforce lists in symbol-plist (let ((s (gensym)) (l (list 1 3 4))) @@ -157,6 +160,8 @@ (let ((x-numbers '(1 2)) (fun (car (list 'member)))) (test x-numbers (member 1 numbers)) + (test x-numbers (member 1 numbers :key 'identity)) + (test x-numbers (member 1 numbers :key #'identity)) (test (cdr x-numbers) (member 2 numbers)) (test nil (member 1.0 numbers )) @@ -178,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)))) @@ -199,6 +203,8 @@ (let ((fun (car (list 'assoc)))) (test (1 a) (assoc 1 numbers)) (test (2 b) (assoc 2 numbers)) + (test (1 a) (assoc 1 numbers :key 'identity)) + (test (2 b) (assoc 2 numbers :key #'identity)) (test nil (assoc 1.0 numbers)) (test (1 a) (assoc 1.0 numbers :test #'=)) @@ -222,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)) @@ -229,3 +325,55 @@ :b '((:a . 1) (:b . 2)))))) (assert (equal '(3 4 5) (funcall (compile nil '(lambda (i l) (member i l))) 3 '(1 2 3 4 5))))) + +;;; bad bounding index pair to SUBSEQ on a list +(let ((list (list 0 1 2 3 4 5))) + (multiple-value-bind (res err) (ignore-errors (subseq list 4 2)) + (assert (not res)) + (assert (typep err 'sb-kernel:bounding-indices-bad-error)))) + +;;; ADJOIN must apply key to item as well +(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=))))) + +;;; constant list argument to ADJOIN +(assert (equal '(:x :y) (funcall + (compile nil '(lambda (elt) + (declare (optimize speed)) + (adjoin elt '(:x :y)))) + ':x))) +(assert (equal '(:x :y) (funcall + (compile nil '(lambda (elt) + (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))))))