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

[Nicolas Petton]

Nicolas Petton <nicolas@petton.fr> writes:

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

See the updated patch below which fixes the documentation:

From 00bd0ef08a9cbb68adbdc5add1f45d8234887d6e 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 |  8 +++++---
 etc/NEWS               |  3 ++-
 src/fns.c              | 15 ++++++++++-----
 src/fontset.c          |  2 +-
 test/src/fns-tests.el  |  6 ++++++
 5 files changed, 24 insertions(+), 10 deletions(-)

diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index 0c99380682..49913294f7 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -1548,10 +1548,12 @@ Association Lists
 that it ignores certain differences between strings.  @xref{Text
 Comparison}.
 
-@defun rassoc value alist
+@defun rassoc value alist &optional testfn
 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{value} 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} 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..8662766426 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

signature.asc
Description: PGP signature