From: Owen Rodley <Strigoides@gmail.com>
Date: Sat, 18 May 2013 04:29:32 +0000 (+1200)
Subject: Rewrite MEMBER using SATISFIES-TEST-P
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;ds=sidebyside;h=c6d504316367c4709e066f58d5593216b150ee5e;p=jscl.git

Rewrite MEMBER using SATISFIES-TEST-P
---

diff --git a/src/list.lisp b/src/list.lisp
index 96a3594..a41d821 100644
--- a/src/list.lisp
+++ b/src/list.lisp
@@ -200,9 +200,10 @@
   (and (consp (cdr x))
        (cons (car x) (butlast (cdr x)))))
 
-(defun member (x list &key (key #'identity) (test #'eql))
+(defun member (x list &key key (test #'eql testp) (test-not #'eql test-not-p)) 
   (while list
-    (when (funcall test x (funcall key (car list)))
+    (when (satisfies-test-p x (car list) :key key :test test :testp testp
+                            :test-not test-not :test-not-p test-not-p)
       (return list))
     (setq list (cdr list))))
 
diff --git a/tests/list.lisp b/tests/list.lisp
index 075a657..c72eec8 100644
--- a/tests/list.lisp
+++ b/tests/list.lisp
@@ -176,6 +176,7 @@
 (test (not   (member 4 '(1 2 3))))
 (test (equal (member 4 '((1 . 2) (3 . 4)) :key #'cdr) '((3 . 4))))
 (test (member '(2) '((1) (2) (3)) :test #'equal))
+(test (member 1 '(1 2 3) :test-not #'eql))
 
 ; ADJOIN
 (test (equal (adjoin 1 '(2 3))   '(1 2 3)))