Improve error messages for improper plists (Bug#27726)

* src/fns.c (Fplist_put, Flax_plist_get, Flax_plist_put)
(Fplist_member, syms_of_fns): Use ‘plistp’ as pseudo-predicate for
improper plists instead of ‘listp.’

* test/src/fns-tests.el (plist-get/odd-number-of-elements)
(lax-plist-get/odd-number-of-elements)
(plist-put/odd-number-of-elements)
(lax-plist-put/odd-number-of-elements)
(plist-member/improper-list): Add unit tests.
This commit is contained in:
Philipp Stephani 2017-09-02 21:08:04 +02:00
parent dbe1e55dc4
commit 71766a45f1
2 changed files with 33 additions and 4 deletions

View file

@ -2021,7 +2021,7 @@ The PLIST is modified by side effects. */)
if (EQ (tail, li.tortoise))
circular_list (plist);
}
CHECK_LIST_END (tail, plist);
CHECK_TYPE (NILP (tail), Qplistp, plist);
Lisp_Object newcell
= Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev))));
if (NILP (prev))
@ -2061,7 +2061,7 @@ one of the properties on the list. */)
circular_list (plist);
}
CHECK_LIST_END (tail, plist);
CHECK_TYPE (NILP (tail), Qplistp, plist);
return Qnil;
}
@ -2093,7 +2093,7 @@ The PLIST is modified by side effects. */)
if (EQ (tail, li.tortoise))
circular_list (plist);
}
CHECK_LIST_END (tail, plist);
CHECK_TYPE (NILP (tail), Qplistp, plist);
Lisp_Object newcell = list2 (prop, val);
if (NILP (prev))
return newcell;
@ -2858,7 +2858,7 @@ The value is actually the tail of PLIST whose car is PROP. */)
if (EQ (tail, li.tortoise))
circular_list (tail);
}
CHECK_LIST_END (tail, plist);
CHECK_TYPE (NILP (tail), Qplistp, plist);
return Qnil;
}
@ -5191,6 +5191,7 @@ Used by `featurep' and `require', and altered by `provide'. */);
Fmake_var_non_special (Qfeatures);
DEFSYM (Qsubfeatures, "subfeatures");
DEFSYM (Qfuncall, "funcall");
DEFSYM (Qplistp, "plistp");
#ifdef HAVE_LANGINFO_CODESET
DEFSYM (Qcodeset, "codeset");

View file

@ -547,4 +547,32 @@
(should-error (nconc (cyc1 1) 'tail) :type 'circular-list)
(should-error (nconc (cyc2 1 2) 'tail) :type 'circular-list))
(ert-deftest plist-get/odd-number-of-elements ()
"Test that plist-get doesnt signal an error on degenerate plists."
(should-not (plist-get '(:foo 1 :bar) :bar)))
(ert-deftest lax-plist-get/odd-number-of-elements ()
"Check for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27726."
(should (equal (should-error (lax-plist-get '(:foo 1 :bar) :bar)
:type 'wrong-type-argument)
'(wrong-type-argument plistp (:foo 1 :bar)))))
(ert-deftest plist-put/odd-number-of-elements ()
"Check for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27726."
(should (equal (should-error (plist-put '(:foo 1 :bar) :zot 2)
:type 'wrong-type-argument)
'(wrong-type-argument plistp (:foo 1 :bar)))))
(ert-deftest lax-plist-put/odd-number-of-elements ()
"Check for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27726."
(should (equal (should-error (lax-plist-put '(:foo 1 :bar) :zot 2)
:type 'wrong-type-argument)
'(wrong-type-argument plistp (:foo 1 :bar)))))
(ert-deftest plist-member/improper-list ()
"Check for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27726."
(should (equal (should-error (plist-member '(:foo 1 . :bar) :qux)
:type 'wrong-type-argument)
'(wrong-type-argument plistp (:foo 1 . :bar)))))
(provide 'fns-tests)