From fb5a0497707b2eb1dd58e7d403172e4f3e23d234 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sun, 25 Sep 2022 17:03:32 +0200 Subject: [PATCH] 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 d2f1aadb65c..964141f338d 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 fe8df7097a7..3f3d9a02855 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 -- 2.39.2