0.pre8.83:

        NSET-EXCLUSIVE-OR does not return extra elements when its
        arguments contain duplicated elements. (reported by Paul
        Dietz)

diff --git a/NEWS b/NEWS
index 4ba4e2f..77caae8 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1680,6 +1680,8 @@ changes in sbcl-0.8.0 relative to sbcl-0.7.14
     ** CONVERT-MORE-CALL failed on a lambda list (&KEY);  (thanks to
        Gerd Moellmann)
     ** &WHOLE and &REST arguments in macro lambda lists are patterns;
+    ** NSET-EXCLUSIVE-OR does not return extra elements when its
+       arguments contain duplicated elements;
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/src/code/list.lisp b/src/code/list.lisp
index 2353c5a..a65faac 100644 (file)
--- a/src/code/list.lisp
+++ b/src/code/list.lisp
@@ -886,32 +886,48 @@
     ;; reached, what is left of LIST2 is tacked onto what is left of
     ;; LIST1. The splicing operation ensures that the correct
     ;; operation is performed depending on whether splice is at the
-    ;; top of the list or not
+    ;; top of the list or not.
     (do ((list1 list1)
          (list2 list2)
          (x list1 (cdr x))
-         (splicex ()))
+         (splicex ())
+         (deleted-y ())
+         ;; elements of LIST2, which are "equal" to some processed
+         ;; earlier elements of LIST1
+         )
         ((endp x)
          (if (null splicex)
              (setq list1 list2)
              (rplacd splicex list2))
          list1)
-      (do ((y list2 (cdr y))
-           (splicey ()))
-          ((endp y) (setq splicex x))
-        (cond ((let ((key-val-x (apply-key key (car x)))
-                     (key-val-y (apply-key key (Car y))))
-                 (if notp
-                     (not (funcall test-not key-val-x key-val-y))
-                     (funcall test key-val-x key-val-y)))
-               (if (null splicex)
-                   (setq list1 (cdr x))
-                   (rplacd splicex (cdr x)))
-               (if (null splicey)
-                   (setq list2 (cdr y))
-                   (rplacd splicey (cdr y)))
-               (return ())) ; assume lists are really sets
-              (t (setq splicey y)))))))
+      (let ((key-val-x (apply-key key (car x)))
+            (found-duplicate nil))
+
+        ;; Move all elements from LIST2, which are "equal" to (CAR X),
+        ;; to DELETED-Y.
+        (do* ((y list2 next-y)
+              (next-y (cdr y) (cdr y))
+              (splicey ()))
+             ((endp y))
+          (cond ((let ((key-val-y (apply-key key (car y))))
+                   (if notp
+                       (not (funcall test-not key-val-x key-val-y))
+                       (funcall test key-val-x key-val-y)))
+                 (if (null splicey)
+                     (setq list2 (cdr y))
+                     (rplacd splicey (cdr y)))
+                 (setq deleted-y (rplacd y deleted-y))
+                 (setq found-duplicate t))
+                (t (setq splicey y))))
+
+        (unless found-duplicate
+          (setq found-duplicate (with-set-keys (member key-val-x deleted-y))))
+
+        (if found-duplicate
+            (if (null splicex)
+                (setq list1 (cdr x))
+                (rplacd splicex (cdr x)))
+            (setq splicex x))))))
 
 (defun subsetp (list1 list2 &key key (test #'eql testp) (test-not nil notp))
   #!+sb-doc

diff --git a/tests/list.pure.lisp b/tests/list.pure.lisp
index 00dc793..9bf32a8 100644 (file)
--- a/tests/list.pure.lisp
+++ b/tests/list.pure.lisp
@@ -110,3 +110,10 @@
                (copy-alist ((1 . 2) (3 . 4) . 5))))
   (assert (raises-error? (apply (first test) (copy-tree (rest test)))
                         type-error)))
+
+;;; Bug reported by Paul Dietz: NSET-EXCLUSIVE-OR should not return
+;;; extra elements, even when given "sets" contain duplications
+(assert (equal (remove-duplicates (sort (nset-exclusive-or (list 1 2 1 3)
+                                                           (list 4 1 3 3))
+                                        #'<))
+               '(2 4)))

diff --git a/version.lisp-expr b/version.lisp-expr
index ac7c4c8..0e366e3 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -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.pre8.82"
+"0.pre8.83"