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.

diff --git a/src/fns.c b/src/fns.c
index d2f1aadb65cd856b35d1b97b4460ea8ef067bc97..964141f338d4d250ef267f521683aaa159bb1c1a 100644 (file)
--- 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 fe8df7097a7262593b152dadaa448e1f957c7ea8..3f3d9a02855f70bc622172f20e1f4f338524570d 100644 (file)
--- 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