0.7.8.11:
authorChristophe Rhodes <csr21@cam.ac.uk>
Wed, 2 Oct 2002 18:17:39 +0000 (18:17 +0000)
committerChristophe Rhodes <csr21@cam.ac.uk>
Wed, 2 Oct 2002 18:17:39 +0000 (18:17 +0000)
Fix bug in MERGE with specifiers of subtypes of LIST
... thanks to Raymond Toy for noticing the problem

src/code/sort.lisp
tests/seq.impure.lisp
version.lisp-expr

index e312715..4b6c02e 100644 (file)
   #!+sb-doc
   "Merge the sequences SEQUENCE1 and SEQUENCE2 destructively into a
    sequence of type RESULT-TYPE using PREDICATE to order the elements."
-  (if (eq result-type 'list)
-      (let ((result (merge-lists* (coerce sequence1 'list)
-                                 (coerce sequence2 'list)
-                                 predicate key)))
-       result)
-      (let* ((vector-1 (coerce sequence1 'vector))
-            (vector-2 (coerce sequence2 'vector))
-            (length-1 (length vector-1))
-            (length-2 (length vector-2))
-            (result (make-sequence result-type
-                                   (+ length-1 length-2))))
-       (declare (vector vector-1 vector-2)
-                (fixnum length-1 length-2))
-
-       #!+high-security (aver (typep result result-type))
-       (if (and (simple-vector-p result)
-                (simple-vector-p vector-1)
-                (simple-vector-p vector-2))
-           (merge-vectors vector-1 length-1 vector-2 length-2
-                          result predicate key svref)
-           (merge-vectors vector-1 length-1 vector-2 length-2
-                          result predicate key aref)))))
+  (let ((type (specifier-type result-type)))
+    (cond
+      ((csubtypep type (specifier-type 'list))
+       (let ((result (merge-lists* (coerce sequence1 'list)
+                                  (coerce sequence2 'list)
+                                  predicate key)))
+        result))
+      ((csubtypep type (specifier-type 'vector))
+       (let* ((vector-1 (coerce sequence1 'vector))
+             (vector-2 (coerce sequence2 'vector))
+             (length-1 (length vector-1))
+             (length-2 (length vector-2))
+             (result (make-sequence result-type
+                                    (+ length-1 length-2))))
+        (declare (vector vector-1 vector-2)
+                 (fixnum length-1 length-2))
+        (if (and (simple-vector-p result)
+                 (simple-vector-p vector-1)
+                 (simple-vector-p vector-2))
+            (merge-vectors vector-1 length-1 vector-2 length-2
+                           result predicate key svref)
+            (merge-vectors vector-1 length-1 vector-2 length-2
+                           result predicate key aref))))
+      (t (bad-sequence-type-error result-type)))))
index 03d612a..4e55b68 100644 (file)
     (assert-type-error (concatenate 'simple-array "foo" "bar"))
     (assert-type-error (map 'simple-array #'identity '(1 2 3)))
     (assert-type-error (coerce '(1 2 3) 'simple-array))
+    (assert-type-error (merge 'simple-array '(1 3) '(2 4) '<))
     ;; but COERCE has an exemption clause:
-    (assert (string= "foo" (coerce "foo" 'simple-array)))))
+    (assert (string= "foo" (coerce "foo" 'simple-array)))
+    ;; ... though not in all cases.
+    (assert-type-error (coerce '(#\f #\o #\o) 'simple-array))))
+
+;;; 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) '<)))
+;;; and also with types that weren't precicely LIST
+(assert (equal '(1 2 3 4) (merge 'cons '(1 3) '(2 4) '<)))
 \f
 ;;; success
 (quit :unix-status 104)
index 1e6ea35..c2f7b61 100644 (file)
@@ -18,4 +18,4 @@
 ;;; internal versions off the main CVS branch, it gets hairier, e.g.
 ;;; "0.pre7.14.flaky4.13".)
 
-"0.7.8.10"
+"0.7.8.11"