From 61b5b64c660481d22a6b79bdec21b884133a7c40 Mon Sep 17 00:00:00 2001 From: Pip Cet 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 +;; 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 . + +;;; 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