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

Rewrite RASSOC using SATISFIES-TEST-P
---

diff --git a/src/list.lisp b/src/list.lisp
index c44907f..c0370b7 100644
--- a/src/list.lisp
+++ b/src/list.lisp
@@ -216,9 +216,11 @@
       (setq alist (cdr alist))))
   (car alist))
 
-(defun rassoc (x alist &key (test #'eql))
+(defun rassoc (x alist &key key (test #'eql) (test #'eql testp)
+                 (test-not #'eql test-not-p))
   (while alist
-    (if (funcall test x (cdar alist))
+    (if (satisfies-test-p x (cdar 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 dd3f135..ac6ae90 100644
--- a/tests/list.lisp
+++ b/tests/list.lisp
@@ -170,8 +170,10 @@
   (test (equal (rassoc 2 alist) '(1 . 2)))
   (test (not   (assoc  2 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))))
+  (test (equal (assoc  3 alist :test-not #'=) '(1 . 2)))
+  (test (equal (rassoc 4 alist :test-not #'=) '(1 . 2)))
+  (test (equal (assoc  1 alist :key (lambda (x) (/ x 3))) '(3 . 4)))
+  (test (equal (rassoc 2 alist :key (lambda (x) (/ x 2))) '(3 . 4)))) 
 
 ; MEMBER
 (test (equal (member 2 '(1 2 3)) '(2 3)))