all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* [PATCH] assq-delete-all, rassq-delete-all: Avoid duplication of code
@ 2016-11-28  9:52 Tino Calancha
  2016-11-28 13:58 ` Herring, Davis
  2016-11-28 17:24 ` Eli Zaretskii
  0 siblings, 2 replies; 6+ messages in thread
From: Tino Calancha @ 2016-11-28  9:52 UTC (permalink / raw)
  To: Emacs developers; +Cc: 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 <tino.calancha@gmail.com>
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



^ permalink raw reply related	[flat|nested] 6+ messages in thread

end of thread, other threads:[~2016-11-29  8:28 UTC | newest]

Thread overview: 6+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2016-11-28  9:52 [PATCH] assq-delete-all, rassq-delete-all: Avoid duplication of code Tino Calancha
2016-11-28 13:58 ` Herring, Davis
2016-11-28 14:35   ` Tino Calancha
2016-11-28 17:24 ` Eli Zaretskii
2016-11-28 18:17   ` Clément Pit--Claudel
2016-11-29  8:28     ` Tino Calancha

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.