0.9.9.16:
authorJuho Snellman <jsnell@iki.fi>
Sun, 5 Feb 2006 23:29:15 +0000 (23:29 +0000)
committerJuho Snellman <jsnell@iki.fi>
Sun, 5 Feb 2006 23:29:15 +0000 (23:29 +0000)
        Fix tests that modify constant data (patch by Lutz Euler).

tests/list.pure.lisp
tests/seq.impure.lisp
tests/seq.pure.lisp
version.lisp-expr

index 1e0a247..ce4ec85 100644 (file)
@@ -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)))))
 
index 8356b90..9684221 100644 (file)
                    (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))
     (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)))
 ;;; 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:
     (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"))
index a0897be..7eac068 100644 (file)
   (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))
 (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"))
index aac7543..bbad5b9 100644 (file)
@@ -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"