X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Flist.pure.lisp;h=555b0c2b0948395fb5c32e04da531a9a47ae8dd6;hb=ed891a4fd882d1b9fe066ab14bcf2107aea95baa;hp=702b89eaa021d51df8f4b1ad94524c0d22ef4af5;hpb=2419deec84b45d81610dc8d3db610c3e2f7b9486;p=sbcl.git diff --git a/tests/list.pure.lisp b/tests/list.pure.lisp index 702b89e..555b0c2 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 )) @@ -199,6 +204,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 #'=)) @@ -236,3 +243,41 @@ (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))))) +(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))) + + +(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 #'<)) +