From e2d1a36734a2fde2e43a4ac1f3e40eab9f2d7e00 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Wed, 2 Oct 2002 18:17:39 +0000 Subject: [PATCH] 0.7.8.11: Fix bug in MERGE with specifiers of subtypes of LIST ... thanks to Raymond Toy for noticing the problem --- src/code/sort.lisp | 46 ++++++++++++++++++++++++---------------------- tests/seq.impure.lisp | 12 +++++++++++- version.lisp-expr | 2 +- 3 files changed, 36 insertions(+), 24 deletions(-) diff --git a/src/code/sort.lisp b/src/code/sort.lisp index e312715..4b6c02e 100644 --- a/src/code/sort.lisp +++ b/src/code/sort.lisp @@ -422,25 +422,27 @@ #!+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))))) diff --git a/tests/seq.impure.lisp b/tests/seq.impure.lisp index 03d612a..4e55b68 100644 --- a/tests/seq.impure.lisp +++ b/tests/seq.impure.lisp @@ -267,8 +267,18 @@ (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) '<))) ;;; success (quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index 1e6ea35..c2f7b61 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -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" -- 1.7.10.4