X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Flist.pure.lisp;h=ce4ec85adc7e56889fd29a171ba1e0658d523f3a;hb=42cb633f2a06d5cbe6b0ec86920cb0d662c49843;hp=b1f588ea4efded356f53c5d5c0a1291695409654;hpb=f6f238261f95e8ffff2870ed3ac6fc00ddf09ef2;p=sbcl.git diff --git a/tests/list.pure.lisp b/tests/list.pure.lisp index b1f588e..ce4ec85 100644 --- a/tests/list.pure.lisp +++ b/tests/list.pure.lisp @@ -6,7 +6,7 @@ ;;;; While most of SBCL is derived from the CMU CL system, the test ;;;; files (like this one) were written from scratch after the fork ;;;; from CMU CL. -;;;; +;;;; ;;;; This software is in the public domain and is provided with ;;;; absolutely no warranty. See the COPYING and CREDITS files for ;;;; more information. @@ -18,34 +18,34 @@ ;;; looks as though it's past time to start accumulating regression ;;; tests for these. (dolist (testcase - '((:args ((1 2 3 4 5)) :result (1 2 3 4)) - (:args ((1 2 3 4 5) 6) :result nil) - (:args (nil) :result nil) - (:args ((1 2 3) 0) :result (1 2 3)) - (:args ((1 2 3) 1) :result (1 2)) - (:args ((1 2 3)) :result (1 2)) - (:args ((1 2 3) 2) :result (1)) - (:args ((1 2 3) 3) :result nil) - (:args ((1 2 3) 4) :result nil) - (:args ((1 2 3 . 4) 0) :result (1 2 3 . 4)) - (:args ((1 2 3 . 4) 1) :result (1 2)) - (:args ((1 2 3 . 4)) :result (1 2)) - (:args ((1 2 3 . 4) 2) :result (1)) - (:args ((1 2 3 . 4) 3) :result nil) - (:args ((1 2 3 . 4) 4) :result nil))) + '((:args ((1 2 3 4 5)) :result (1 2 3 4)) + (:args ((1 2 3 4 5) 6) :result nil) + (:args (nil) :result nil) + (:args ((1 2 3) 0) :result (1 2 3)) + (:args ((1 2 3) 1) :result (1 2)) + (:args ((1 2 3)) :result (1 2)) + (:args ((1 2 3) 2) :result (1)) + (:args ((1 2 3) 3) :result nil) + (:args ((1 2 3) 4) :result nil) + (:args ((1 2 3 . 4) 0) :result (1 2 3 . 4)) + (:args ((1 2 3 . 4) 1) :result (1 2)) + (:args ((1 2 3 . 4)) :result (1 2)) + (:args ((1 2 3 . 4) 2) :result (1)) + (:args ((1 2 3 . 4) 3) :result nil) + (:args ((1 2 3 . 4) 4) :result nil))) (destructuring-bind (&key args result) testcase (destructuring-bind (list &rest rest) args ;; Test with BUTLAST. (let ((actual-result (apply #'butlast args))) - (when (and (consp list) (eq actual-result list)) - (error "not a copy in BUTLAST for ~S" args)) - (unless (equal actual-result result) - (error "failed BUTLAST for ~S" args))) + (when (and (consp list) (eq actual-result list)) + (error "not a copy in BUTLAST for ~S" args)) + (unless (equal actual-result result) + (error "failed BUTLAST for ~S" args))) ;; Test with NBUTLAST. (let* ((copied-list (copy-list list)) - (actual-result (apply #'nbutlast copied-list rest))) - (unless (equal actual-result result) - (error "failed NBUTLAST for ~S" args)))))) + (actual-result (apply #'nbutlast copied-list rest))) + (unless (equal actual-result result) + (error "failed NBUTLAST for ~S" args)))))) (multiple-value-bind (result error) (ignore-errors (apply #'butlast (list t))) @@ -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))))) @@ -107,9 +107,9 @@ (reverse (1 2 . 3)) (nreverse (1 2 . 3)) (nreconc (1 2 . 3) (4 5)) - (copy-alist ((1 . 2) (3 . 4) . 5)))) + (copy-alist ((1 . 2) (3 . 4) . 5)))) (assert (raises-error? (apply (first test) (copy-tree (rest test))) - type-error))) + type-error))) ;;; Bug reported by Paul Dietz: NSET-EXCLUSIVE-OR should not return ;;; extra elements, even when given "sets" contain duplications