bug#27584: 26.0.50; alist-get: Add optional arg TESTFN

[Nicolas Petton]

Nicolas Petton <nicolas@petton.fr> writes:

> Eli Zaretskii <eliz@gnu.org> writes:
>
>> Something like this:
>>
>>   FOR_EACH_TAIL (tail)
>>     {
>>       Lisp_Object car = XCAR (tail);
>>       if (CONSP (car)
>>        && (NILP (testfn)
>>            ? (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key)))
>>            : !NILP (call2 (testfn, XCAR (car), key))))
>>      return car;
>>     }
>
> I installed your version in master.

Here's another patch that adds a similar `testfn' parameter to `rassoc':

From 103f7a5cdd80961e654fca879aba1b9a67d4eb22 Mon Sep 17 00:00:00 2001
From: Nicolas Petton <nicolas@petton.fr>
Date: Tue, 1 Aug 2017 18:29:34 +0200
Subject: [PATCH] Add an optional testfn parameter to rassoc

* src/fns.c (rassoc): Add an optional testfn parameter.  When non-nil,
use this parameter for comparison instead of equal.
* src/fontset.c (fs_query_fontset): Update usage of Frassoc.
* test/src/fns-tests.el (test-rassoc-tesfn): Add unit tests for the
new testfn parameter.
* etc/NEWS:
* doc/lispref/lists.texi: Document the change.
---
 doc/lispref/lists.texi |  6 ++++--
 etc/NEWS               |  3 ++-
 src/fns.c              | 15 ++++++++++-----
 src/fontset.c          |  2 +-
 test/src/fns-tests.el  |  6 ++++++
 5 files changed, 23 insertions(+), 9 deletions(-)

diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index 0c99380682..321246de12 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -1550,8 +1550,10 @@ Association Lists
 
 @defun rassoc value alist
 This function returns the first association with value @var{value} in
-@var{alist}.  It returns @code{nil} if no association in @var{alist} has
-a @sc{cdr} @code{equal} to @var{value}.
+@var{alist}, comparing @var{key} against the alist elements using
+@var{testfn} if non-nil, or @code{equal} if nil (@pxref{Equality
+Predicates}).  It returns @code{nil} if no association in @var{alist}
+has a @sc{cdr} @code{equal} to @var{value}.
 
 @code{rassoc} is like @code{assoc} except that it compares the @sc{cdr} of
 each @var{alist} association instead of the @sc{car}.  You can think of
diff --git a/etc/NEWS b/etc/NEWS
index 44f5ff5bde..50734b846f 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -105,7 +105,8 @@ The effect is similar to that of "toolBar" resource on the 
tool bar.
 * Changes in Emacs 26.1
 
 +++
-** The function 'assoc' now takes an optional third argument 'testfn'.
+** The functions 'assoc' and 'rassoc ' now take an optional third
+argument 'testfn'.
 This argument, when non-nil, is used for comparison instead of
 'equal'.
 
diff --git a/src/fns.c b/src/fns.c
index d849618f2b..9e7d47253f 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -1474,17 +1474,22 @@ The value is actually the first element of LIST whose 
cdr is KEY.  */)
   return Qnil;
 }
 
-DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0,
-       doc: /* Return non-nil if KEY is `equal' to the cdr of an element of 
LIST.
-The value is actually the first element of LIST whose cdr equals KEY.  */)
-  (Lisp_Object key, Lisp_Object list)
+DEFUN ("rassoc", Frassoc, Srassoc, 2, 3, 0,
+       doc: /* Return non-nil if KEY is equal to the cdr of an element of LIST.
+The value is actually the first element of LIST whose cdr equals KEY.
+
+Equality is defined by TESTFN is non-nil or by `equal' if nil.  */)
+  (Lisp_Object key, Lisp_Object list, Lisp_Object testfn)
 {
   Lisp_Object tail = list;
   FOR_EACH_TAIL (tail)
     {
       Lisp_Object car = XCAR (tail);
       if (CONSP (car)
-         && (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key))))
+         && (NILP (testfn)
+             ? (EQ (XCDR (car), key) || !NILP (Fequal
+                                               (XCDR (car), key)))
+             : !NILP (call2 (testfn, XCDR (car), key))))
        return car;
     }
   CHECK_LIST_END (tail, list);
diff --git a/src/fontset.c b/src/fontset.c
index 74018060b8..4666b607ba 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -1184,7 +1184,7 @@ fs_query_fontset (Lisp_Object name, int name_pattern)
   name = Fdowncase (name);
   if (name_pattern != 1)
     {
-      tem = Frassoc (name, Vfontset_alias_alist);
+      tem = Frassoc (name, Vfontset_alias_alist, Qnil);
       if (NILP (tem))
        tem = Fassoc (name, Vfontset_alias_alist, Qnil);
       if (CONSP (tem) && STRINGP (XCAR (tem)))
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index e294859226..83d7935a41 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -379,6 +379,12 @@ dot2
     (should (eq (assoc "b" alist #'string-equal) (cadr alist)))
     (should-not (assoc "b" alist #'eq))))
 
+(ert-deftest test-rassoc-testfn ()
+  (let ((alist '((a . "1") (b . "2"))))
+    (should-not (rassoc "1" alist #'ignore))
+    (should (eq (rassoc "2" alist #'string-equal) (cadr alist)))
+    (should-not (rassoc "2" alist #'eq))))
+
 (ert-deftest test-cycle-rassq ()
   (let ((c1 (cyc1 '(0 . 1)))
         (c2 (cyc2 '(0 . 1) '(0 . 2)))
-- 
2.13.3

Cheers,
Nico

signature.asc
Description: PGP signature