0.7.8.46:

	Continue maintenance work on LIST-like type specifiers
	... fix COERCE and MERGE analogously to MAKE-SEQUENCE
	... note, but don't worry too much yet, about circular list
		arguments to COERCE and MERGE

diff --git a/src/code/coerce.lisp b/src/code/coerce.lisp
index dfd208d..576aba5 100644 (file)
--- a/src/code/coerce.lisp
+++ b/src/code/coerce.lisp
@@ -192,10 +192,23 @@
           res))
        ((csubtypep type (specifier-type 'list))
         (if (vectorp object)
-            (vector-to-list* object)
+            (cond ((type= type (specifier-type 'list))
+                   (vector-to-list* object))
+                  ((type= type (specifier-type 'null))
+                   (if (= (length object) 0)
+                       'nil
+                       (sequence-type-length-mismatch-error type
+                                                            (length object))))
+                  ((csubtypep (specifier-type '(cons nil t)) type)
+                   (if (> (length object) 0)
+                       (vector-to-list* object)
+                       (sequence-type-length-mismatch-error type 0)))
+                  (t (sequence-type-too-hairy (type-specifier type))))
             (coerce-error)))
        ((csubtypep type (specifier-type 'vector))
         (typecase object
+          ;; FOO-TO-VECTOR* go through MAKE-SEQUENCE, so length
+          ;; errors are caught there. -- CSR, 2002-10-18
           (list (list-to-vector* object output-type-spec))
           (vector (vector-to-vector* object output-type-spec))
           (t

diff --git a/src/code/sort.lisp b/src/code/sort.lisp
index 4b6c02e..78c291d 100644 (file)
--- a/src/code/sort.lisp
+++ b/src/code/sort.lisp
@@ -235,7 +235,7 @@
                     drag))))      ;   and return pointer to last element.
     (cond ((apply-pred (car list-2) (car list-1) pred key)
           (rplacd p list-2)       ; Append the lesser list to last cell of
-          (setq p (cdr p))         ;   result. Note: test must bo done for
+          (setq p (cdr p))         ;   result. Note: test must be done for
           (pop list-2))               ;   LIST-2 < LIST-1 so merge will be
          (T (rplacd p list-1)   ;   stable for LIST-1.
             (setq p (cdr p))
@@ -425,10 +425,29 @@
   (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))
+       ;; the VECTOR clause, below, goes through MAKE-SEQUENCE, so
+       ;; benefits from the error checking there. Short of
+       ;; reimplementing everything, we can't do the same for the LIST
+       ;; case, so do relevant length checking here:
+       (let ((s1 (coerce sequence1 'list))
+            (s2 (coerce sequence2 'list)))
+        (when (type= type (specifier-type 'list))
+          (return-from merge (values (merge-lists* s1 s2 predicate key))))
+        (when (eq type *empty-type*)
+          (bad-sequence-type-error nil))
+        (when (type= type (specifier-type 'null))
+          (if (and (null s1) (null s2))
+              (return-from merge 'nil)
+              ;; FIXME: This will break on circular lists (as,
+              ;; indeed, will the whole MERGE function).
+              (sequence-type-length-mismatch-error type
+                                                   (+ (length s1)
+                                                      (length s2)))))
+        (if (csubtypep (specifier-type '(cons nil t)) type)
+            (if (and (null s1) (null s2))
+                (sequence-type-length-mismatch-error type 0)
+                (values (merge-lists* s1 s2 predicate key)))
+            (sequence-type-too-hairy result-type))))
       ((csubtypep type (specifier-type 'vector))
        (let* ((vector-1 (coerce sequence1 'vector))
              (vector-2 (coerce sequence2 'vector))

diff --git a/tests/seq.impure.lisp b/tests/seq.impure.lisp
index 5aea01c..ec6e74f 100644 (file)
--- a/tests/seq.impure.lisp
+++ b/tests/seq.impure.lisp
@@ -300,7 +300,19 @@
     (assert (= (length (make-sequence 'cons 3)) 3))
     ;; and NIL is not a valid type for MAKE-SEQUENCE
     (assert-type-error (make-sequence 'nil 0))
-    ;; tests for MAP/MERGE/CONCATENATE/COERCE to come.
+    ;; COERCE
+    (assert-type-error (coerce #(1) 'null))
+    (assert-type-error (coerce #() 'cons))
+    (assert (null (coerce #() 'null)))
+    (assert (= (length (coerce #(1) 'cons)) 1))
+    (assert-type-error (coerce #() 'nil))
+    ;; MERGE
+    (assert-type-error (merge 'null '(1 3) '(2 4) '<))
+    (assert-type-error (merge 'cons () () '<))
+    (assert (null (merge 'null () () '<)))
+    (assert (= (length (merge 'cons '(1 3) '(2 4) '<)) 4))
+    (assert-type-error (merge 'nil () () '<))
+    ;; tests for MAP/CONCATENATE to come.
     ))
 
             

diff --git a/version.lisp-expr b/version.lisp-expr
index 64b4fcf..5f9e608 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.7.8.45"
+"0.7.8.46"