From 4625ad7852c0d2fe53e7c51b76c5f8f116c8a944 Mon Sep 17 00:00:00 2001 From: Owen Rodley Date: Sat, 18 May 2013 16:35:13 +1200 Subject: [PATCH] Rewrite RASSOC using SATISFIES-TEST-P --- src/list.lisp | 6 ++++-- tests/list.lisp | 6 ++++-- 2 files changed, 8 insertions(+), 4 deletions(-) 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))) -- 1.7.10.4