Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv16690/tests
Modified Files:
list.pure.lisp
Log Message:
1.0.7.25: better MEMBER transform
* Specialized versions for different keyword combinations: %MEMBER,
%MEMBER-TEST, %MEMBER-KEY-TEST, etc. These versions have positional
arguments, and the callable arguments are known to be functions.
* The transform open codes for all combinations of keywords if the
second argument is constant and (>= SPEED SPACE). Otherwise the
transform selects the appropriate specialized version and open
codes %COERCE-CALLABLE-TO-FUN around keyword arguments, allowing
type inference to optimize it away for arguments known to be
functions.
* Tests.
Index: list.pure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/list.pure.lisp,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -d -r1.14 -r1.15
--- list.pure.lisp 16 Jul 2007 16:52:53 -0000 1.14
+++ list.pure.lisp 17 Jul 2007 13:18:06 -0000 1.15
@@ -146,3 +146,37 @@
(ignore-errors (setf (symbol-plist s) (car l)))
(assert (not res))
(assert (typep err 'type-error))))
+
+;;; member
+
+(macrolet ((test (expected form)
+ `(progn
+ (assert (eq ,expected (funcall fun ,@(cdr form))))
+ (assert (eq ,expected (funcall (lambda ()
+ (declare (optimize speed))
+ ,form))))
+ (assert (eq ,expected (funcall (lambda ()
+ (declare (optimize space))
+ ,form)))))))
+ (let ((numbers '(1 2))
+ (fun (car (list 'member))))
+ (test numbers (member 1 numbers))
+ (test (cdr numbers) (member 2 numbers))
+ (test nil (member 1.0 numbers ))
+
+ (test numbers (member 1.0 numbers :test #'=))
+ (test numbers (member 1.0 numbers :test #'= :key nil))
+ (test (cdr numbers) (member 2.0 numbers :test '=))
+ (test nil (member 0 numbers :test '=))
+
+ (test numbers (member 0 numbers :test-not #'>))
+ (test (cdr numbers) (member 1 numbers :test-not 'eql))
+ (test nil (member 0 numbers :test-not '<))
+
+ (test numbers (member -1 numbers :key #'-))
+ (test (cdr numbers) (member -2 numbers :key '-))
+ (test nil (member -1.0 numbers :key #'-))
+
+ (test numbers (member -1.0 numbers :key #'- :test '=))
+ (test (cdr numbers) (member -2.0 numbers :key #'- :test '=))
+ (test nil (member -1.0 numbers :key #'- :test 'eql))))
|