From 23a229276c2447a658b7a30217ec774067c27d5e Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Fri, 16 May 2008 06:55:05 +0000 Subject: [PATCH] 1.0.16.33: UNION and NUNION work with :TEST-NOT again * Patch by Eric Marsden. Broken at 1.0.9.1 by yours truly. --- NEWS | 2 ++ src/code/list.lisp | 4 ++-- tests/compiler.pure.lisp | 4 ++-- tests/list.pure.lisp | 19 +++++++++++++++++++ version.lisp-expr | 2 +- 5 files changed, 26 insertions(+), 5 deletions(-) diff --git a/NEWS b/NEWS index 18d415f..db3a9d3 100644 --- a/NEWS +++ b/NEWS @@ -13,6 +13,8 @@ changes in sbcl-1.0.17 relative to 1.0.16: in normal SPEED policies. * optimization: NCONC no longer needs to heap cons its &REST list in normal SPEED policies. + * bug fix: UNION and NUNION work with :TEST-NOT once more, + regression since 1.0.9.1. (thanks to Eric Marsden) * bug fix: result of MAKE-ARRAY can be stack allocated - regression since 1.0.15.36. (thanks to Paul Khuong) * bug fix: LAST when always returned the whole list when given a bignum diff --git a/src/code/list.lisp b/src/code/list.lisp index 551420d..045e1de 100644 --- a/src/code/list.lisp +++ b/src/code/list.lisp @@ -873,7 +873,7 @@ (key (and key (%coerce-callable-to-fun key))) (test (if notp (let ((test-not-fun (%coerce-callable-to-fun test-not))) - (lambda (x) (not (funcall test-not-fun x)))) + (lambda (x y) (not (funcall test-not-fun x y)))) (%coerce-callable-to-fun test)))) (multiple-value-bind (short long n-short) (if (< n1 n2) @@ -922,7 +922,7 @@ (key (and key (%coerce-callable-to-fun key))) (test (if notp (let ((test-not-fun (%coerce-callable-to-fun test-not))) - (lambda (x) (not (funcall test-not-fun x)))) + (lambda (x y) (not (funcall test-not-fun x y)))) (%coerce-callable-to-fun test)))) (multiple-value-bind (short long n-short) (if (< n1 n2) diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index 9b5289d..f14cbdf 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -2356,9 +2356,9 @@ ;;; ;;; no :MOVE-ARG VOP defined to move # (SC SB-VM::SINGLE-REG) to # (SC SB-VM::ANY-REG) ;;; [Condition of type SIMPLE-ERROR] -(compile nil +(compile nil '(lambda (frob) - (labels + (labels ((%zig (frob) (typecase frob (double-float diff --git a/tests/list.pure.lisp b/tests/list.pure.lisp index 921500d..555b0c2 100644 --- a/tests/list.pure.lisp +++ b/tests/list.pure.lisp @@ -262,3 +262,22 @@ (declare (optimize speed)) (adjoin elt '(:y)))) ':x))) + + +(macrolet ((test (expected list-1 list-2 &rest args) + `(progn + (assert (equal ,expected (funcall #'union ,list-1 ,list-2 ,@args))) + (assert (equal ,expected (funcall #'nunion + (copy-list ,list-1) + (copy-list ,list-2) + ,@args)))))) + (test nil nil nil) + (test '(42) nil '(42)) + (test '(42) '(42) nil) + (test '(42) '(42) '(42)) + (test '((42) (42)) '((42)) '((42))) + (test '((42) (42)) '((42)) '((42)) :test-not #'equal) + (test '((42)) '((42)) '((42)) :test #'equal) + (test '((42)) '((42)) '((42)) :key #'car) + (test '((42)) '((42)) '((42)) :key #'car :test-not #'<)) + diff --git a/version.lisp-expr b/version.lisp-expr index b56b2e5..096d1e7 100644 --- 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".) -"1.0.16.32" +"1.0.16.33" -- 1.7.10.4