[Emacs-diffs] master 71766a4: Improve error messages for improper plists (Bug#27726)

[Philipp Stephani]

branch: master
commit 71766a45f1edb02ec5107803a7f7a8e17809b093
Author: Philipp Stephani <address@hidden>
Commit: Philipp Stephani <address@hidden>

    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.
---
 src/fns.c             |  9 +++++----
 test/src/fns-tests.el | 28 ++++++++++++++++++++++++++++
 2 files changed, 33 insertions(+), 4 deletions(-)

diff --git a/src/fns.c b/src/fns.c
index 00b6ed6..ef9a175 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -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");
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index e294859..73c6593 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -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’ doesn’t 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)