Fix (CONCATENATE 'null ...) for generic sequences

 * (CONCATENATE 'NULL SEQUENCE1 SEQUENCE2 ...) ensures that SEQUENCE1,
   SEQUENCE2, ... are empty, but only did so for lists and
   vectors. Instead, use new function EMPTYP which works for all
   sequences. EMPTYP is not exported.

 * Add generic function SEQUENCE:EMPTYP to which EMPTYP dispatches for
   generic sequences. Methods for lists, vectors and generic sequences
   use NULL or (ZEROP (LENGTH ...)).

 * Test cases in seq.impure.lisp.

 * Patch by Jan Moringen; fixes lp#1162301.

diff --git a/NEWS b/NEWS
index 105f6e5..11a6507 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -59,6 +59,8 @@ changes relative to sbcl-1.1.7:
     recursion no longer causes undescriptive compiler errors. (lp#1180992)
   * bug fix: sub-word BOOLEAN alien types now disregard higher order bits
     when testing for non-zero-ness.
+  * bug fix: (CONCATENATE 'null ...) no longer fails for generic sequences.
+    (lp#1162301)
   * optimization: faster ISQRT on fixnums and small bignums
   * optimization: faster and smaller INTEGER-LENGTH on fixnums on x86-64.
   * optimization: On x86-64, the number of multi-byte NOP instructions used

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 2731792..4b8befe 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -2334,7 +2334,7 @@ be submitted as a CDR"
 
                "CANONIZE-TEST" "CANONIZE-KEY"
 
-               "LENGTH" "ELT"
+               "EMPTYP" "LENGTH" "ELT"
                "MAKE-SEQUENCE-LIKE" "ADJUST-SEQUENCE"
 
                "COUNT" "COUNT-IF" "COUNT-IF-NOT"

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index f2f9cd4..2cd9d52 100644 (file)
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -266,6 +266,16 @@
            :type '(and list (satisfies list-length)))))
 
 \f
+
+(defun emptyp (sequence)
+  #!+sb-doc
+  "Returns T if SEQUENCE is an empty sequence and NIL
+   otherwise. Signals an error if SEQUENCE is not a sequence."
+  (seq-dispatch sequence
+                (null sequence)
+                (zerop (length sequence))
+                (sb!sequence:emptyp sequence)))
+
 (defun elt (sequence index)
   #!+sb-doc "Return the element of SEQUENCE specified by INDEX."
   (seq-dispatch sequence
@@ -851,14 +861,10 @@ many elements are copied."
            ((eq type *empty-type*)
             (bad-sequence-type-error nil))
            ((type= type (specifier-type 'null))
-            (if (every (lambda (x) (or (null x)
-                                       (and (vectorp x) (= (length x) 0))))
-                       sequences)
-                'nil
-                (sequence-type-length-mismatch-error
-                 type
-                 ;; FIXME: circular list issues.
-                 (reduce #'+ sequences :key #'length))))
+            (unless (every #'emptyp sequences)
+              (sequence-type-length-mismatch-error
+               type (reduce #'+ sequences :key #'length))) ; FIXME: circular list issues.
+            '())
            ((cons-type-p type)
             (multiple-value-bind (min exactp)
                 (sb!kernel::cons-type-length-info type)

diff --git a/src/pcl/sequence.lisp b/src/pcl/sequence.lisp
index 7dc5904..89912ad 100644 (file)
--- a/src/pcl/sequence.lisp
+++ b/src/pcl/sequence.lisp
@@ -17,6 +17,11 @@
   (error 'sequence::protocol-unimplemented
          :datum sequence :expected-type '(or list vector)))
 
+(defgeneric sequence:emptyp (sequence)
+  (:method ((s list)) (null s))
+  (:method ((s vector)) (zerop (length s)))
+  (:method ((s sequence)) (zerop (length s))))
+
 (defgeneric sequence:length (sequence)
   (:method ((s list)) (length s))
   (:method ((s vector)) (length s))

diff --git a/tests/seq.impure.lisp b/tests/seq.impure.lisp
index e497115..9616cde 100644 (file)
--- a/tests/seq.impure.lisp
+++ b/tests/seq.impure.lisp
@@ -21,6 +21,8 @@
 
 (in-package :seq-test)
 
+;;; user-defined mock sequence class for testing generic versions of
+;;; sequence functions.
 (defclass list-backed-sequence (standard-object
                                 sequence)
   ((elements :initarg :elements :type list :accessor %elements)))
@@ -133,6 +135,12 @@
 (assert (eql 4 ; modified more, avoids charset technicalities completely
              (find 5 '(6 4) :test '>)))
 
+(with-test (:name sequence:emptyp)
+  (for-every-seq #()
+    '((eq t (sequence:emptyp seq))))
+  (for-every-seq #(1)
+    '((eq nil (sequence:emptyp seq)))))
+
 ;;; tests of FIND, POSITION, FIND-IF, and POSITION-IF (and a few for
 ;;; deprecated FIND-IF-NOT and POSITION-IF-NOT too)
 (for-every-seq #()
@@ -327,6 +335,24 @@
     ;; ... though not in all cases.
     (assert-type-error (coerce '(#\f #\o #\o) 'simple-array))))
 
+;; CONCATENATE used to fail for generic sequences for result-type NULL.
+(with-test (:name (concatenate :result-type-null :bug-1162301))
+  (assert (sequence:emptyp (concatenate 'null)))
+
+  (for-every-seq #()
+    '((sequence:emptyp (concatenate 'null seq))
+      (sequence:emptyp (concatenate 'null seq seq))
+      (sequence:emptyp (concatenate 'null seq #()))
+      (sequence:emptyp (concatenate 'null seq ""))))
+
+  (for-every-seq #(1)
+    (mapcar (lambda (form)
+              `(typep (nth-value 1 (ignore-errors ,form)) 'type-error))
+            '((concatenate 'null seq)
+              (concatenate 'null seq seq)
+              (concatenate 'null seq #())
+              (concatenate 'null seq "2")))))
+
 ;;; 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)
@@ -375,10 +401,8 @@
                4))
     (assert-type-error (merge 'nil () () '<))
     ;; CONCATENATE
-    (assert-type-error (concatenate 'null '(1) "2"))
     (assert-type-error (concatenate 'cons #() ()))
     (assert-type-error (concatenate '(cons t null) #(1 2 3) #(4 5 6)))
-    (assert (null (concatenate 'null () #())))
     (assert (= (length (concatenate 'cons #() '(1) "2 3")) 4))
     (assert (= (length (concatenate '(cons t cons) '(1) "34")) 3))
     (assert-type-error (concatenate 'nil '(3)))