[PATCH] assq-delete-all, rassq-delete-all: Avoid duplication of code

[Tino Calancha]

Hello,

how about following patch?
It prevent some duplication of code in subr.el, and it adds
a new test.

Regards,
Tino

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
>From 3597746c9c5ebcc7d7252fb9051475d52936ee20 Mon Sep 17 00:00:00 2001
From: Tino Calancha <address@hidden>
Date: Mon, 28 Nov 2016 18:41:40 +0900
Subject: [PATCH] assq-delete-all, rassq-delete-all: Avoid duplication of code

* lisp/subr.el (assq-delete-all-1): New defun.
(assq-delete-all, rassq-delete-all): Use it.
* test/lisp/subr-tests.el (subr-test-assq-delete-all): New test.
---
 lisp/subr.el            | 35 +++++++++++++++--------------------
 test/lisp/subr-tests.el | 12 ++++++++++++
 2 files changed, 27 insertions(+), 20 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index 5da5bf8..28f6f74 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -570,35 +570,30 @@ member-ignore-case
     (setq list (cdr list)))
   list)
 
+(defun assq-delete-all-1 (elt alist key)
+  (let ((op (if key #'car #'cdr)))
+    (while (and (consp (car alist))
+                (eq (funcall op (car alist)) elt))
+      (setq alist (cdr alist)))
+    (let ((tail alist))
+      (while (cdr tail)
+        (if (and (consp (cadr tail))
+                 (eq (funcall op (cadr tail)) elt))
+            (setcdr tail (cddr tail))
+          (setq tail (cdr tail)))))
+    alist))
+
 (defun assq-delete-all (key alist)
   "Delete from ALIST all elements whose car is `eq' to KEY.
 Return the modified alist.
 Elements of ALIST that are not conses are ignored."
-  (while (and (consp (car alist))
-             (eq (car (car alist)) key))
-    (setq alist (cdr alist)))
-  (let ((tail alist) tail-cdr)
-    (while (setq tail-cdr (cdr tail))
-      (if (and (consp (car tail-cdr))
-              (eq (car (car tail-cdr)) key))
-         (setcdr tail (cdr tail-cdr))
-       (setq tail tail-cdr))))
-  alist)
+  (assq-delete-all-1 key alist 'key))
 
 (defun rassq-delete-all (value alist)
   "Delete from ALIST all elements whose cdr is `eq' to VALUE.
 Return the modified alist.
 Elements of ALIST that are not conses are ignored."
-  (while (and (consp (car alist))
-             (eq (cdr (car alist)) value))
-    (setq alist (cdr alist)))
-  (let ((tail alist) tail-cdr)
-    (while (setq tail-cdr (cdr tail))
-      (if (and (consp (car tail-cdr))
-              (eq (cdr (car tail-cdr)) value))
-         (setcdr tail (cdr tail-cdr))
-       (setq tail tail-cdr))))
-  alist)
+  (assq-delete-all-1 value alist nil))
 
 (defun alist-get (key alist &optional default remove)
   "Return the value associated with KEY in ALIST, using `assq'.
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index ce21290..018c13b 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -224,5 +224,17 @@
               (error-message-string (should-error (version-to-list 
"beta22_8alpha3")))
               "Invalid version syntax: `beta22_8alpha3' (must start with a 
number)"))))
 
+(ert-deftest subr-test-assq-delete-all ()
+  "Tests for `assq-delete-all' and `rassq-delete-all'."
+  (let ((alist '((foo . 1) (bar . 1) (baz . 1) (foo . 2))))
+    (should (equal '((bar . 1) (baz . 1))
+                   (assq-delete-all 'foo (copy-tree alist))))
+    (should (equal '((foo . 2)) (rassq-delete-all 1 (copy-tree alist))))
+    (should (equal alist (assq-delete-all 'qux (copy-tree alist))))
+    (should (equal alist (rassq-delete-all 9 (copy-tree alist))))
+    (should (equal alist
+                   (assq-delete-all (make-symbol "foo") (copy-tree alist))))
+    (should (equal alist (rassq-delete-all 1.0 (copy-tree alist))))))
+
 (provide 'subr-tests)
 ;;; subr-tests.el ends here
-- 
2.10.2

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
In GNU Emacs 26.0.50.1 (x86_64-pc-linux-gnu, GTK+ Version 3.22.3)
 of 2016-11-28
Repository revision: d020ff3eab01f9683485b35c0fc8b17708e9a6d1