From: Owen Rodley Date: Sat, 18 May 2013 04:32:50 +0000 (+1200) Subject: Rewrite ASSOC using SATISFIES-TEST-P X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=6432dcb404266426cd0cbec1a47ec7d4a42b23af;p=jscl.git Rewrite ASSOC using SATISFIES-TEST-P --- diff --git a/src/list.lisp b/src/list.lisp index a41d821..c44907f 100644 --- a/src/list.lisp +++ b/src/list.lisp @@ -208,9 +208,10 @@ (setq list (cdr list)))) -(defun assoc (x alist &key (test #'eql)) +(defun assoc (x alist &key key (test #'eql testp) (test-not #'eql test-not-p)) (while alist - (if (funcall test x (caar alist)) + (if (satisfies-test-p x (caar alist) :key key :test test :testp testp + :test-not test-not :test-not-p test-not-p) (return) (setq alist (cdr alist)))) (car alist)) diff --git a/tests/list.lisp b/tests/list.lisp index c72eec8..dd3f135 100644 --- a/tests/list.lisp +++ b/tests/list.lisp @@ -169,7 +169,9 @@ (test (equal (assoc 1 alist) '(1 . 2))) (test (equal (rassoc 2 alist) '(1 . 2))) (test (not (assoc 2 alist))) - (test (not (rassoc 1 alist)))) + (test (not (rassoc 1 alist))) + (test (equal (assoc 3 alist :test-not #'=) '(1 . 2))) + (test (equal (assoc 1 alist :key (lambda (x) (/ x 3))) '(3 . 4)))) ; MEMBER (test (equal (member 2 '(1 2 3)) '(2 3)))