emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

master fb5a049770: Don't crash in copy-alist with non-list argument


From: Mattias Engdegård
Subject: master fb5a049770: Don't crash in copy-alist with non-list argument
Date: Sun, 25 Sep 2022 11:13:40 -0400 (EDT)

branch: master
commit fb5a0497707b2eb1dd58e7d403172e4f3e23d234
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    Don't crash in copy-alist with non-list argument
    
    * src/fns.c (Fcopy_alist): Check argument type.
    * test/src/fns-tests.el (fns--copy-alist): New test.
---
 src/fns.c             |  1 +
 test/src/fns-tests.el | 27 +++++++++++++++++++++++++++
 2 files changed, 28 insertions(+)

diff --git a/src/fns.c b/src/fns.c
index d2f1aadb65..964141f338 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -1417,6 +1417,7 @@ Elements of ALIST that are not conses are also shared.  
*/)
 {
   if (NILP (alist))
     return alist;
+  CHECK_CONS (alist);
   alist = Fcopy_sequence (alist);
   for (Lisp_Object tem = alist; !NILP (tem); tem = XCDR (tem))
     {
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index fe8df7097a..3f3d9a0285 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -1422,4 +1422,31 @@
     (should (equal (ntake (- most-negative-fixnum 1) list) nil))
     (should (equal list '(a b c)))))
 
+(ert-deftest fns--copy-alist ()
+  (dolist (orig '(nil
+                  ((a . 1) (b . 2) (a . 3))
+                  (a (b . 3) ((c) (d)))))
+    (ert-info ((prin1-to-string orig) :prefix "orig: ")
+      (let ((copy (copy-alist orig)))
+        (should (equal orig copy))
+        (while orig
+          (should-not (eq orig copy))
+          ;; Check that cons pairs are copied but nothing else.
+          (let ((orig-elt (car orig))
+                (copy-elt (car copy)))
+            (if (atom orig-elt)
+                (should (eq orig-elt copy-elt))
+              (should-not (eq orig-elt copy-elt))
+              (should (eq (car orig-elt) (car copy-elt)))
+              (should (eq (cdr orig-elt) (cdr copy-elt)))))
+          (setq orig (cdr orig))
+          (setq copy (cdr copy))))))
+
+  (should-error (copy-alist 'a)
+                :type 'wrong-type-argument)
+  (should-error (copy-alist [(a . 1) (b . 2) (a . 3)])
+                :type 'wrong-type-argument)
+  (should-error (copy-alist "abc")
+                :type 'wrong-type-argument))
+
 ;;; fns-tests.el ends here



reply via email to

[Prev in Thread] Current Thread [Next in Thread]