bug#36403: 27.0.50; Trivial image.c bugs

[Pip Cet <pipcet@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 195 bytes --]

On Fri, Jun 28, 2019 at 7:53 PM Eli Zaretskii <eliz@gnu.org> wrote:
> > Attached patch has tests and fixes.
>
> Thanks.  Let's wait for a few days to let others comment.

Rebased patch attached.

[-- Attachment #2: 0001-Fix-minor-bugs-in-image.c-bug-36403.patch --]
[-- Type: text/x-patch, Size: 7140 bytes --]

From 61b5b64c660481d22a6b79bdec21b884133a7c40 Mon Sep 17 00:00:00 2001
From: Pip Cet <pipcet@gmail.com>
Date: Fri, 28 Jun 2019 14:47:57 +0000
Subject: [PATCH] Fix minor bugs in image.c (bug#36403)

* test/src/image-tests.el (image-test-circular-specs): New file.
* src/image.c (parse_image_spec): Return failure for circular lists.
(valid_image_p): Don't look at odd-numbered list elements expecting to
find a property name.
(image_spec_value): Handle circular lists.
(equal_lists): Introduce.
(search_image_cache): Use `equal_lists'.
---
 src/image.c             | 70 +++++++++++++++++++++++++++--------------
 test/src/image-tests.el | 65 ++++++++++++++++++++++++++++++++++++++
 2 files changed, 111 insertions(+), 24 deletions(-)
 create mode 100644 test/src/image-tests.el

diff --git a/src/image.c b/src/image.c
index 355c849491..fbc636d651 100644
--- a/src/image.c
+++ b/src/image.c
@@ -800,17 +800,22 @@ valid_image_p (Lisp_Object object)
     {
       Lisp_Object tail = XCDR (object);
       FOR_EACH_TAIL_SAFE (tail)
-	if (EQ (XCAR (tail), QCtype))
-	  {
-	    tail = XCDR (tail);
-	    if (CONSP (tail))
-	      {
-		struct image_type const *type = lookup_image_type (XCAR (tail));
-		if (type)
-		  return type->valid_p (object);
-	      }
-	    break;
-	  }
+	{
+	  if (EQ (XCAR (tail), QCtype))
+	    {
+	      tail = XCDR (tail);
+	      if (CONSP (tail))
+		{
+		  struct image_type const *type = lookup_image_type (XCAR (tail));
+		  if (type)
+		    return type->valid_p (object);
+		}
+	      break;
+	    }
+	  tail = XCDR (tail);
+	  if (! CONSP (tail))
+	    return false;
+	}
     }
 
   return false;
@@ -897,7 +902,7 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords,
     return false;
 
   plist = XCDR (spec);
-  while (CONSP (plist))
+  FOR_EACH_TAIL_SAFE (plist)
     {
       Lisp_Object key, value;
 
@@ -911,7 +916,6 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords,
       if (!CONSP (plist))
 	return false;
       value = XCAR (plist);
-      plist = XCDR (plist);
 
       /* Find key in KEYWORDS.  Error if not found.  */
       for (i = 0; i < nkeywords; ++i)
@@ -919,7 +923,7 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords,
 	  break;
 
       if (i == nkeywords)
-	continue;
+	goto maybe_done;
 
       /* Record that we recognized the keyword.  If a keyword
 	 was found more than once, it's an error.  */
@@ -1006,14 +1010,20 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords,
 
       if (EQ (key, QCtype) && !EQ (type, value))
 	return false;
-    }
 
-  /* Check that all mandatory fields are present.  */
-  for (i = 0; i < nkeywords; ++i)
-    if (keywords[i].count < keywords[i].mandatory_p)
-      return false;
+    maybe_done:
+      if (EQ (XCDR (plist), Qnil))
+	{
+	  /* Check that all mandatory fields are present.  */
+	  for (i = 0; i < nkeywords; ++i)
+	    if (keywords[i].mandatory_p && keywords[i].count == 0)
+	      return false;
+
+	  return true;
+	}
+    }
 
-  return NILP (plist);
+  return false;
 }
 
 
@@ -1028,9 +1038,8 @@ image_spec_value (Lisp_Object spec, Lisp_Object key, bool *found)
 
   eassert (valid_image_p (spec));
 
-  for (tail = XCDR (spec);
-       CONSP (tail) && CONSP (XCDR (tail));
-       tail = XCDR (XCDR (tail)))
+  tail = XCDR (spec);
+  FOR_EACH_TAIL_SAFE (tail)
     {
       if (EQ (XCAR (tail), key))
 	{
@@ -1038,6 +1047,9 @@ image_spec_value (Lisp_Object spec, Lisp_Object key, bool *found)
 	    *found = 1;
 	  return XCAR (XCDR (tail));
 	}
+      tail = XCDR (tail);
+      if (! CONSP (tail))
+	break;
     }
 
   if (found)
@@ -1572,6 +1584,16 @@ make_image_cache (void)
   return c;
 }
 
+/* Compare two lists (one of which must be proper), comparing each
+   element with `eq'.  */
+static bool
+equal_lists (Lisp_Object a, Lisp_Object b)
+{
+  while (CONSP (a) && CONSP (b) && EQ (XCAR (a), XCAR (b)))
+    a = XCDR (a), b = XCDR (b);
+
+  return EQ (a, b);
+}
 
 /* Find an image matching SPEC in the cache, and return it.  If no
    image is found, return NULL.  */
@@ -1598,7 +1620,7 @@ search_image_cache (struct frame *f, Lisp_Object spec, EMACS_UINT hash)
 
   for (img = c->buckets[i]; img; img = img->next)
     if (img->hash == hash
-	&& !NILP (Fequal (img->spec, spec))
+	&& !equal_lists (img->spec, spec)
 	&& img->frame_foreground == FRAME_FOREGROUND_PIXEL (f)
 	&& img->frame_background == FRAME_BACKGROUND_PIXEL (f))
       break;
diff --git a/test/src/image-tests.el b/test/src/image-tests.el
new file mode 100644
index 0000000000..4325237de9
--- /dev/null
+++ b/test/src/image-tests.el
@@ -0,0 +1,65 @@
+;;; image-tests.el --- Test suite for image-related functions.
+
+;; Copyright (C) 2019 Free Software Foundation, Inc.
+
+;; Author: Pip Cet <pipcet@gmail.com>
+;; Keywords:       internal
+;; Human-Keywords: internal
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+
+(ert-deftest image-test-duplicate-keywords ()
+  "Test that duplicate keywords in an image spec lead to rejection."
+  (should-error (image-size `(image :type xbm :type xbm :width 1 :height 1
+                                    :data ,(bool-vector t))
+                            t)))
+
+(ert-deftest image-test-circular-plist ()
+  "Test that a circular image spec is rejected."
+  (should-error
+   (let ((l `(image :type xbm :width 1 :height 1 :data ,(bool-vector t))))
+     (setcdr (last l) '#1=(:invalid . #1#))
+     (image-size l t))))
+
+(ert-deftest image-test-:type-property-value ()
+  "Test that :type is allowed as a property value in an image spec."
+  (should (equal (image-size `(image :dummy :type :type xbm :width 1 :height 1
+                                        :data ,(bool-vector t))
+                                t)
+                 (cons 1 1))))
+
+(ert-deftest image-test-circular-specs ()
+  "Test that circular image spec property values do not cause infinite recursion."
+  (should
+   (let* ((circ1 (cons :dummy nil))
+          (circ2 (cons :dummy nil))
+          (spec1 `(image :type xbm :width 1 :height 1
+                         :data ,(bool-vector 1) :ignored ,circ1))
+          (spec2 `(image :type xbm :width 1 :height 1
+                        :data ,(bool-vector 1) :ignored ,circ2)))
+     (setcdr circ1 circ1)
+     (setcdr circ2 circ2)
+     (and (equal (image-size spec1 t) (cons 1 1))
+          (equal (image-size spec2 t) (cons 1 1))))))
+
+(provide 'image-tests)
+;;; image-tests.el ends here.
-- 
2.22.0