From: Juho Snellman Date: Sun, 5 Feb 2006 23:29:15 +0000 (+0000) Subject: 0.9.9.16: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=42cb633f2a06d5cbe6b0ec86920cb0d662c49843;p=sbcl.git 0.9.9.16: Fix tests that modify constant data (patch by Lutz Euler). --- diff --git a/tests/list.pure.lisp b/tests/list.pure.lisp index 1e0a247..ce4ec85 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))))) diff --git a/tests/seq.impure.lisp b/tests/seq.impure.lisp index 8356b90..9684221 100644 --- a/tests/seq.impure.lisp +++ b/tests/seq.impure.lisp @@ -242,13 +242,15 @@ (coerce #(0 0 0 1 1 1) `(,@type-stub 6)))) (assert-type-error (concatenate `(,@type-stub 5) #(0 0 0) #*111)) ;; MERGE - (assert (= (length (merge `(,@type-stub) #(0 1 0) #*111 #'>)) 6)) - (assert (equalp (merge `(,@type-stub) #(0 1 0) #*111 #'>) - (coerce #(1 1 1 0 1 0) `(,@type-stub)))) - (assert (= (length (merge `(,@type-stub 6) #(0 1 0) #*111 #'>)) 6)) - (assert (equalp (merge `(,@type-stub 6) #(0 1 0) #*111 #'>) - (coerce #(1 1 1 0 1 0) `(,@type-stub 6)))) - (assert-type-error (merge `(,@type-stub 4) #(0 1 0) #*111 #'>)) + (macrolet ((test (type) + `(merge ,type (copy-seq #(0 1 0)) (copy-seq #*111) #'>))) + (assert (= (length (test `(,@type-stub))) 6)) + (assert (equalp (test `(,@type-stub)) + (coerce #(1 1 1 0 1 0) `(,@type-stub)))) + (assert (= (length (test `(,@type-stub 6))) 6)) + (assert (equalp (test `(,@type-stub 6)) + (coerce #(1 1 1 0 1 0) `(,@type-stub 6)))) + (assert-type-error (test `(,@type-stub 4)))) ;; MAP (assert (= (length (map `(,@type-stub) #'logxor #(0 0 1 1) '(0 1 0 1))) 4)) (assert (equalp (map `(,@type-stub) #'logxor #(0 0 1 1) '(0 1 0 1)) @@ -274,7 +276,7 @@ (assert (equalp #(11 13) (map '(simple-array fixnum (*)) #'+ '(1 2 3) '(10 11)))) (assert-type-error (coerce '(1 2 3) 'simple-array)) - (assert-type-error (merge 'simple-array '(1 3) '(2 4) '<)) + (assert-type-error (merge 'simple-array (list 1 3) (list 2 4) '<)) (assert (equalp #(3 2 1) (coerce '(3 2 1) '(vector fixnum)))) (assert-type-error (map 'array #'identity '(1 2 3))) (assert-type-error (map '(array fixnum) #'identity '(1 2 3))) @@ -287,9 +289,9 @@ ;;; As pointed out by Raymond Toy on #lisp IRC, MERGE had some issues ;;; with user-defined types until sbcl-0.7.8.11 (deftype list-typeoid () 'list) -(assert (equal '(1 2 3 4) (merge 'list-typeoid '(1 3) '(2 4) '<))) +(assert (equal '(1 2 3 4) (merge 'list-typeoid (list 1 3) (list 2 4) '<))) ;;; and also with types that weren't precicely LIST -(assert (equal '(1 2 3 4) (merge 'cons '(1 3) '(2 4) '<))) +(assert (equal '(1 2 3 4) (merge 'cons (list 1 3) (list 2 4) '<))) ;;; but wait, there's more! The NULL and CONS types also have implicit ;;; length requirements: @@ -322,12 +324,14 @@ (assert (= (length (coerce #(1) '(cons t null))) 1)) (assert-type-error (coerce #() 'nil)) ;; MERGE - (assert-type-error (merge 'null '(1 3) '(2 4) '<)) + (assert-type-error (merge 'null (list 1 3) (list 2 4) '<)) (assert-type-error (merge 'cons () () '<)) (assert (null (merge 'null () () '<))) - (assert (= (length (merge 'cons '(1 3) '(2 4) '<)) 4)) + (assert (= (length (merge 'cons (list 1 3) (list 2 4) '<)) 4)) (assert (= (length (merge '(cons t (cons t (cons t (cons t null)))) - '(1 3) '(2 4) '<)) 4)) + (list 1 3) (list 2 4) + '<)) + 4)) (assert-type-error (merge 'nil () () '<)) ;; CONCATENATE (assert-type-error (concatenate 'null '(1) "2")) diff --git a/tests/seq.pure.lisp b/tests/seq.pure.lisp index a0897be..7eac068 100644 --- a/tests/seq.pure.lisp +++ b/tests/seq.pure.lisp @@ -169,7 +169,7 @@ (assert s2) (assert (string= s2 "zzzzz"))) -;;; POSITION on dispaced arrays with non-zero offset has been broken +;;; POSITION on displaced arrays with non-zero offset has been broken ;;; for quite a while... (let ((fn (compile nil '(lambda (x) (position x))))) (let* ((x #(1 2 3)) @@ -180,7 +180,7 @@ (let ((a (make-sequence '(simple-string) 5)) (b (concatenate '(simple-string) "a" "bdec")) (c (map '(simple-string) 'identity "abcde")) - (d (merge '(simple-string) "acd" "be" 'char>)) + (d (merge '(simple-string) (copy-seq "acd") (copy-seq "be") 'char>)) (e (coerce '(#\a #\b #\c #\e #\d) '(simple-string)))) (assert (= (length a) 5)) (assert (string= b "abdec")) diff --git a/version.lisp-expr b/version.lisp-expr index aac7543..bbad5b9 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.9.15" +"0.9.9.16"