Update of /cvsroot/sbcl/sbcl/tests
In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv8838/tests
Modified Files:
seq.impure.lisp
Log Message:
1.0.29.5: list item seek transform needs to check for both :TEST and :TEST-NOT
* When both are provided, abort the transform and let the full call
take care of signalling the error. Reported by Tobias Ritterweiler.
Index: seq.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/seq.impure.lisp,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -d -r1.39 -r1.40
--- seq.impure.lisp 17 May 2009 17:30:23 -0000 1.39
+++ seq.impure.lisp 9 Jun 2009 12:23:52 -0000 1.40
@@ -13,10 +13,11 @@
;;;; absolutely no warranty. See the COPYING and CREDITS files for
;;;; more information.
+(load "test-util.lisp")
(load "assertoid.lisp")
(defpackage :seq-test
- (:use :cl :assertoid))
+ (:use :cl :assertoid :test-util))
(in-package :seq-test)
@@ -1100,5 +1101,21 @@
(assert (raises-error? (fill l 0 :start 4)))
(assert (raises-error? (fill l 0 :end 4)))
(assert (raises-error? (fill l 0 :start 2 :end 1))))
+
+;;; Both :TEST and :TEST-NOT provided
+(with-test (:name :test-and-test-not-to-adjoin)
+ (let* ((wc 0)
+ (fun
+ (handler-bind (((and warning (not style-warning))
+ (lambda (w) (incf wc))))
+ (compile nil `(lambda (item test test-not) (adjoin item '(1 2 3 :foo)
+ :test test
+ :test-not test-not))))))
+ (assert (= 1 wc))
+ (assert (eq :error
+ (handler-case
+ (funcall fun 1 #'eql (complement #'eql))
+ (error ()
+ :error))))))
;;; success
|