X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Flist.pure.lisp;h=4e61a7cd66a9c444af15e6b2c1a5531d671a47b6;hb=1ac7e7c95d8badd4ff01d676dffece6b710cea13;hp=1e0a247981d2c306d61b232e16411fb8a12f44ea;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git diff --git a/tests/list.pure.lisp b/tests/list.pure.lisp index 1e0a247..4e61a7c 100644 --- a/tests/list.pure.lisp +++ b/tests/list.pure.lisp @@ -81,7 +81,7 @@ (loop for (args result) in tests do (assert (equal (apply 'nconc (copy-tree args)) result)) do (let ((exp `(nconc ,@ (mapcar (lambda (arg) - `',(copy-tree arg)) + `(copy-tree ',arg)) args)))) (assert (equal (funcall (compile nil `(lambda () ,exp))) result))))) @@ -97,7 +97,7 @@ (loop for (args fail) in tests do (check-error (apply #'nconc (copy-tree args)) fail) do (let ((exp `(nconc ,@ (mapcar (lambda (arg) - `',(copy-tree arg)) + `(copy-tree ',arg)) args)))) (check-error (funcall (compile nil `(lambda () ,exp))) fail))))) @@ -136,3 +136,47 @@ (assoc x '(nil (a . b) nil (nil . c) (c . d)) :test #'eq))))) (assert (equal (funcall f 'nil) '(nil . c)))) + +;;; enforce lists in symbol-plist +(let ((s (gensym)) + (l (list 1 3 4))) + (assert (not (symbol-plist s))) + (assert (eq l (setf (symbol-plist s) l))) + (multiple-value-bind (res err) + (ignore-errors (setf (symbol-plist s) (car l))) + (assert (not res)) + (assert (typep err 'type-error)))) + +;;; member + +(macrolet ((test (expected form) + `(progn + (assert (eq ,expected (funcall fun ,@(cdr form)))) + (assert (eq ,expected (funcall (lambda () + (declare (optimize speed)) + ,form)))) + (assert (eq ,expected (funcall (lambda () + (declare (optimize space)) + ,form))))))) + (let ((numbers '(1 2)) + (fun (car (list 'member)))) + (test numbers (member 1 numbers)) + (test (cdr numbers) (member 2 numbers)) + (test nil (member 1.0 numbers )) + + (test numbers (member 1.0 numbers :test #'=)) + (test numbers (member 1.0 numbers :test #'= :key nil)) + (test (cdr numbers) (member 2.0 numbers :test '=)) + (test nil (member 0 numbers :test '=)) + + (test numbers (member 0 numbers :test-not #'>)) + (test (cdr numbers) (member 1 numbers :test-not 'eql)) + (test nil (member 0 numbers :test-not '<)) + + (test numbers (member -1 numbers :key #'-)) + (test (cdr numbers) (member -2 numbers :key '-)) + (test nil (member -1.0 numbers :key #'-)) + + (test numbers (member -1.0 numbers :key #'- :test '=)) + (test (cdr numbers) (member -2.0 numbers :key #'- :test '=)) + (test nil (member -1.0 numbers :key #'- :test 'eql))))