all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* bug#36403: 27.0.50; Trivial image.c bugs
@ 2019-06-27 16:28 Pip Cet
  2019-06-27 17:40 ` Eli Zaretskii
  0 siblings, 1 reply; 20+ messages in thread
From: Pip Cet @ 2019-06-27 16:28 UTC (permalink / raw)
  To: 36403

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

These are all in the category "Lisp code does something silly, the
image code breaks".

(let ((l `(image :type xbm :type xbm :height 1 :width 1 :data
,(bool-vector t))))
  (insert-image l))

inserts an image. It should consider the spec erroneous.
--
(let ((tail (cons :invalid nil)))
   (setcdr tail tail)
   (insert-image `(image :type xbm . ,tail)))

causes an infinite loop. It should be considered invalid.
--
(insert-image `(image :dummy :type :type xbm :height 1 :width 1 :data
,(bool-vector t)))

produces an error. It should arguably behave the same as

(insert-image `(image :dummy :dummy :type xbm :height 1 :width 1 :data
,(bool-vector t)))
--
(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)
  (insert-image spec1)
  (insert-image spec2))

livelocks emacs somehow. It should...I don't know. Abort because the
spec is circular? Not compare specs using Fequal?
--
(insert-image `(image :type postscript :pt-width 100 :pt-height 100
              :ascent 0
              :bounding-box (0 0 100 100) :file "dummy.ps"
              :loader ,(lambda (frame spec width height id colors)
                 (setf (plist-get spec :ascent)
                       -1))))

livelocks Emacs in the display code. It should automatically switch to
the buffer called "image.c" and rewrite the code there not to call
Lisp.
--
These probably aren't worth fixing in their own right, but someone
might think image.c is a good place to take plist handling code
from...

I think with the exception of the contrived last example, these are
all easy to fix, but a bit harder to fix well. I've tried to do the
former, for now, but I'd welcome any help for me to do the latter.

[-- Attachment #2: 0001-Fix-minor-image-bugs.patch --]
[-- Type: text/x-patch, Size: 4514 bytes --]

From eef20e02d25a16f71ad0904644d68450a6181fe2 Mon Sep 17 00:00:00 2001
From: Pip Cet <pipcet@gmail.com>
Date: Thu, 27 Jun 2019 16:19:25 +0000
Subject: [PATCH] Fix minor image bugs.

    * src/image.c (valid_image_p): Don't check value elements of the plist
for key equality.
(parse_image_spec): Use FOR_EACH_TAIL_SAFE to abort for circular
structures. Fix off-by-one error.
(image_spec_value): Handle circular structures.
(equal_lists): Introduce; compares two lists' elements with `eq'
(search_image_cache): Don't call Fequal from redisplay code.
---
 src/image.c | 73 +++++++++++++++++++++++++++++++++++------------------
 1 file changed, 48 insertions(+), 25 deletions(-)

diff --git a/src/image.c b/src/image.c
index 7b648c46ae..89ba2b9d29 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 0;
 
   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 0;
       value = XCAR (plist);
-      plist = XCDR (plist);
 
       /* Find key in KEYWORDS.  Error if not found.  */
       for (i = 0; i < nkeywords; ++i)
@@ -921,10 +925,10 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords,
       if (i == nkeywords)
 	continue;
 
-      /* Record that we recognized the keyword.  If a keywords
+      /* Record that we recognized the keyword.  If a keyword
 	 was found more than once, it's an error.  */
       keywords[i].value = value;
-      if (keywords[i].count > 1)
+      if (keywords[i].count > 0)
 	return 0;
       ++keywords[i].count;
 
@@ -1006,14 +1010,22 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords,
 
       if (EQ (key, QCtype) && !EQ (type, value))
 	return 0;
-    }
 
-  /* Check that all mandatory fields are present.  */
-  for (i = 0; i < nkeywords; ++i)
-    if (keywords[i].mandatory_p && keywords[i].count == 0)
-      return 0;
+      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 0;
+
+	  return 1;
+	}
+
+      if (! CONSP (plist))
+	return 0;
+    }
 
-  return NILP (plist);
+  return 0;
 }
 
 
@@ -1028,9 +1040,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 +1049,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 +1586,15 @@ make_image_cache (void)
   return c;
 }
 
+/* Compare two (non-circular) lists, comparing each element with `eq'. */
+static bool
+equal_lists (Lisp_Object a, Lisp_Object b)
+{
+  while (CONSP (a) && CONSP (b) && Feq (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 +1621,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;
-- 
2.20.1


^ permalink raw reply related	[flat|nested] 20+ messages in thread

* bug#36403: 27.0.50; Trivial image.c bugs
  2019-06-27 16:28 bug#36403: 27.0.50; Trivial image.c bugs Pip Cet
@ 2019-06-27 17:40 ` Eli Zaretskii
  2019-06-28 15:05   ` Pip Cet
  0 siblings, 1 reply; 20+ messages in thread
From: Eli Zaretskii @ 2019-06-27 17:40 UTC (permalink / raw)
  To: Pip Cet; +Cc: 36403

> From: Pip Cet <pipcet@gmail.com>
> Date: Thu, 27 Jun 2019 16:28:05 +0000
> 
> I think with the exception of the contrived last example, these are
> all easy to fix, but a bit harder to fix well. I've tried to do the
> former, for now, but I'd welcome any help for me to do the latter.

Thanks, but please also add tests which verify that these problems no
longer happen after the fix.





^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#36403: 27.0.50; Trivial image.c bugs
  2019-06-27 17:40 ` Eli Zaretskii
@ 2019-06-28 15:05   ` Pip Cet
  2019-06-28 19:52     ` Eli Zaretskii
  0 siblings, 1 reply; 20+ messages in thread
From: Pip Cet @ 2019-06-28 15:05 UTC (permalink / raw)
  To: Eli Zaretskii; +Cc: 36403

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

On Thu, Jun 27, 2019 at 5:40 PM Eli Zaretskii <eliz@gnu.org> wrote:
> > From: Pip Cet <pipcet@gmail.com>
> > Date: Thu, 27 Jun 2019 16:28:05 +0000
> >
> > I think with the exception of the contrived last example, these are
> > all easy to fix, but a bit harder to fix well. I've tried to do the
> > former, for now, but I'd welcome any help for me to do the latter.
>
> Thanks, but please also add tests which verify that these problems no
> longer happen after the fix.

Thanks for reminding me of that! I looked into that, and it seems
there are no image tests so far.

Attached patch has tests and fixes.

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

From aed4b965c34af99a48473798524382c76d57978e 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

* 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 f3d6508f46..2de56fdeed 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.20.1


^ permalink raw reply related	[flat|nested] 20+ messages in thread

* bug#36403: 27.0.50; Trivial image.c bugs
  2019-06-28 15:05   ` Pip Cet
@ 2019-06-28 19:52     ` Eli Zaretskii
  2019-07-22  2:55       ` Pip Cet
  0 siblings, 1 reply; 20+ messages in thread
From: Eli Zaretskii @ 2019-06-28 19:52 UTC (permalink / raw)
  To: Pip Cet; +Cc: 36403

> From: Pip Cet <pipcet@gmail.com>
> Date: Fri, 28 Jun 2019 15:05:30 +0000
> Cc: 36403@debbugs.gnu.org
> 
> > Thanks, but please also add tests which verify that these problems no
> > longer happen after the fix.
> 
> Thanks for reminding me of that! I looked into that, and it seems
> there are no image tests so far.

There are some in test/manual.  they are there because they need to be
run interactively.

> Attached patch has tests and fixes.

Thanks.  Let's wait for a few days to let others comment.





^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#36403: 27.0.50; Trivial image.c bugs
  2019-06-28 19:52     ` Eli Zaretskii
@ 2019-07-22  2:55       ` Pip Cet
  2019-07-26  6:56         ` Eli Zaretskii
  0 siblings, 1 reply; 20+ messages in thread
From: Pip Cet @ 2019-07-22  2:55 UTC (permalink / raw)
  To: Eli Zaretskii; +Cc: 36403

[-- 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


^ permalink raw reply related	[flat|nested] 20+ messages in thread

* bug#36403: 27.0.50; Trivial image.c bugs
  2019-07-22  2:55       ` Pip Cet
@ 2019-07-26  6:56         ` Eli Zaretskii
  2019-07-28 14:50           ` Pip Cet
  0 siblings, 1 reply; 20+ messages in thread
From: Eli Zaretskii @ 2019-07-26  6:56 UTC (permalink / raw)
  To: Pip Cet; +Cc: 36403

> From: Pip Cet <pipcet@gmail.com>
> Date: Mon, 22 Jul 2019 02:55:50 +0000
> Cc: 36403@debbugs.gnu.org
> 
> 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.

Thanks.

Now that I applied this and looked into the results and the code, I
have a few questions/comments.  Sorry I didn't see this earlier.

In your bug report, you say, among other things:

> (insert-image `(image :dummy :type :type xbm :height 1 :width 1 :data
> ,(bool-vector t)))
> 
> produces an error. It should arguably behave the same as
> 
> (insert-image `(image :dummy :dummy :type xbm :height 1 :width 1 :data
> ,(bool-vector t)))

Can you explain why these two are equivalent?

> (equal_lists): Introduce.
> (search_image_cache): Use `equal_lists'.

I don't think I understand why we need this new function.  Can you explain?

Finally, 2 of the tests fail for me:

  $ make src/image-tests.log
    ELC      src/image-tests.elc
    GEN      src/image-tests.log
  Running 4 tests (2019-07-26 09:49:33+0300, selector `(not (tag :unstable))')
  Test image-test-:type-property-value backtrace:
    signal(error ("Window system frame should be used"))
    apply(signal (error ("Window system frame should be used")))
    (setq value-13 (apply fn-11 args-12))
    (unwind-protect (setq value-13 (apply fn-11 args-12)) (setq form-des
    (if (unwind-protect (setq value-13 (apply fn-11 args-12)) (setq form
    (let (form-description-15) (if (unwind-protect (setq value-13 (apply
    (let ((value-13 'ert-form-evaluation-aborted-14)) (let (form-descrip
    (let* ((fn-11 #'equal) (args-12 (condition-case err (let ((signal-ho
    (lambda nil (let* ((fn-11 #'equal) (args-12 (condition-case err (let
    ert--run-test-internal(#s(ert--test-execution-info :test #s(ert-test
    ert-run-test(#s(ert-test :name image-test-:type-property-value :docu
    ert-run-or-rerun-test(#s(ert--stats :selector (not (tag :unstable))
    ert-run-tests((not (tag :unstable)) #f(compiled-function (event-type
    ert-run-tests-batch((not (tag :unstable)))
    ert-run-tests-batch-and-exit((not (tag :unstable)))
    eval((ert-run-tests-batch-and-exit '(not (tag :unstable))) t)
    command-line-1((#("-L" 0 2 (charset cp862)) #(";." 0 2 (charset cp86
    command-line()
    normal-top-level()
  Test image-test-:type-property-value condition:
      (error "Window system frame should be used")
     FAILED  1/4  image-test-:type-property-value (0.000000 sec)
     passed  2/4  image-test-circular-plist (0.000000 sec)
  Test image-test-circular-specs backtrace:
    image-size((image :type xbm :width 1 :height 1 :data #&1"\1" :ignore
    (equal (image-size spec1 t) (cons 1 1))
    (and (equal (image-size spec1 t) (cons 1 1)) (equal (image-size spec
    (let* ((circ1 (cons :dummy nil)) (circ2 (cons :dummy nil)) (spec1 (l
    (setq value-16 (let* ((circ1 (cons :dummy nil)) (circ2 (cons :dummy
    (unwind-protect (setq value-16 (let* ((circ1 (cons :dummy nil)) (cir
    (if (unwind-protect (setq value-16 (let* ((circ1 (cons :dummy nil))
    (let (form-description-17) (if (unwind-protect (setq value-16 (let*
    (let ((value-16 (gensym "ert-form-evaluation-aborted-"))) (let (form
    (lambda nil (let ((value-16 (gensym "ert-form-evaluation-aborted-"))
    ert--run-test-internal(#s(ert--test-execution-info :test #s(ert-test
    ert-run-test(#s(ert-test :name image-test-circular-specs :documentat
    ert-run-or-rerun-test(#s(ert--stats :selector (not (tag :unstable))
    ert-run-tests((not (tag :unstable)) #f(compiled-function (event-type
    ert-run-tests-batch((not (tag :unstable)))
    ert-run-tests-batch-and-exit((not (tag :unstable)))
    eval((ert-run-tests-batch-and-exit '(not (tag :unstable))) t)
    command-line-1((#("-L" 0 2 (charset cp862)) #(";." 0 2 (charset cp86
    command-line()
    normal-top-level()
  Test image-test-circular-specs condition:
      (error "Window system frame should be used")
     FAILED  3/4  image-test-circular-specs (0.000000 sec)
     passed  4/4  image-test-duplicate-keywords (0.000000 sec)

  Ran 4 tests, 2 results as expected, 2 unexpected (2019-07-26 09:49:35+0300, 1.906250 sec)

  2 unexpected results:
     FAILED  image-test-:type-property-value
     FAILED  image-test-circular-specs





^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#36403: 27.0.50; Trivial image.c bugs
  2019-07-26  6:56         ` Eli Zaretskii
@ 2019-07-28 14:50           ` Pip Cet
  2019-09-24 16:26             ` Lars Ingebrigtsen
  0 siblings, 1 reply; 20+ messages in thread
From: Pip Cet @ 2019-07-28 14:50 UTC (permalink / raw)
  To: Eli Zaretskii; +Cc: 36403

On Fri, Jul 26, 2019 at 6:56 AM Eli Zaretskii <eliz@gnu.org> wrote:
> > From: Pip Cet <pipcet@gmail.com>
> > Date: Mon, 22 Jul 2019 02:55:50 +0000
> > Cc: 36403@debbugs.gnu.org
> >
> > 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.
>
> Thanks.
>
> Now that I applied this and looked into the results and the code, I
> have a few questions/comments.  Sorry I didn't see this earlier.

No problem at all, and thank you, as always, for your thoughtful comments!

> In your bug report, you say, among other things:
>
> > (insert-image `(image :dummy :type :type xbm :height 1 :width 1 :data
> > ,(bool-vector t)))
> >
> > produces an error. It should arguably behave the same as
> >
> > (insert-image `(image :dummy :dummy :type xbm :height 1 :width 1 :data
> > ,(bool-vector t)))
>
> Can you explain why these two are equivalent?

The ":dummy" property should be ignored, whether its value is ":dummy"
or ":type"; previously, we used the first occurence of :type even if
it was at an odd offset in the plist.

> > (equal_lists): Introduce.
> > (search_image_cache): Use `equal_lists'.
>
> I don't think I understand why we need this new function.  Can you explain?

IIRC, Fequal throwing a signal at this point caused a livelock, so we
needed a stricter check. I'll look into it again to see whether
there's a better alternative.

Thanks again!





^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#36403: 27.0.50; Trivial image.c bugs
  2019-07-28 14:50           ` Pip Cet
@ 2019-09-24 16:26             ` Lars Ingebrigtsen
  2020-08-03  7:47               ` Lars Ingebrigtsen
  0 siblings, 1 reply; 20+ messages in thread
From: Lars Ingebrigtsen @ 2019-09-24 16:26 UTC (permalink / raw)
  To: Pip Cet; +Cc: 36403

Pip Cet <pipcet@gmail.com> writes:

> IIRC, Fequal throwing a signal at this point caused a livelock, so we
> needed a stricter check. I'll look into it again to see whether
> there's a better alternative.

This was eight weeks ago, and as far as I can tell, the patch (which
looks sensible) wasn't applied.  Has there been any further progress
here?

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no





^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#36403: 27.0.50; Trivial image.c bugs
  2019-09-24 16:26             ` Lars Ingebrigtsen
@ 2020-08-03  7:47               ` Lars Ingebrigtsen
  2020-08-18 16:28                 ` Lars Ingebrigtsen
  0 siblings, 1 reply; 20+ messages in thread
From: Lars Ingebrigtsen @ 2020-08-03  7:47 UTC (permalink / raw)
  To: Pip Cet; +Cc: 36403

Lars Ingebrigtsen <larsi@gnus.org> writes:

> Pip Cet <pipcet@gmail.com> writes:
>
>> IIRC, Fequal throwing a signal at this point caused a livelock, so we
>> needed a stricter check. I'll look into it again to see whether
>> there's a better alternative.
>
> This was eight weeks ago, and as far as I can tell, the patch (which
> looks sensible) wasn't applied.  Has there been any further progress
> here?

And that was 44 weeks ago.  :-)  The patch still applies.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no





^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#36403: 27.0.50; Trivial image.c bugs
  2020-08-03  7:47               ` Lars Ingebrigtsen
@ 2020-08-18 16:28                 ` Lars Ingebrigtsen
  2020-08-20 23:03                   ` Alan Third
  0 siblings, 1 reply; 20+ messages in thread
From: Lars Ingebrigtsen @ 2020-08-18 16:28 UTC (permalink / raw)
  To: Pip Cet; +Cc: 36403

Lars Ingebrigtsen <larsi@gnus.org> writes:

> Lars Ingebrigtsen <larsi@gnus.org> writes:
>
>> Pip Cet <pipcet@gmail.com> writes:
>>
>>> IIRC, Fequal throwing a signal at this point caused a livelock, so we
>>> needed a stricter check. I'll look into it again to see whether
>>> there's a better alternative.
>>
>> This was eight weeks ago, and as far as I can tell, the patch (which
>> looks sensible) wasn't applied.  Has there been any further progress
>> here?
>
> And that was 44 weeks ago.  :-)  The patch still applies.

I've now applied the patch, but I moved the test suite to test/manual --
they call `image-size', which requires a frame to be present...  which
isn't the case when running "make test", unfortunately.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no





^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#36403: 27.0.50; Trivial image.c bugs
  2020-08-18 16:28                 ` Lars Ingebrigtsen
@ 2020-08-20 23:03                   ` Alan Third
  2020-08-20 23:13                     ` Lars Ingebrigtsen
  0 siblings, 1 reply; 20+ messages in thread
From: Alan Third @ 2020-08-20 23:03 UTC (permalink / raw)
  To: Lars Ingebrigtsen; +Cc: 36403, Pip Cet

On Tue, Aug 18, 2020 at 06:28:19PM +0200, Lars Ingebrigtsen wrote:
> Lars Ingebrigtsen <larsi@gnus.org> writes:
> 
> > Lars Ingebrigtsen <larsi@gnus.org> writes:
> >
> >> Pip Cet <pipcet@gmail.com> writes:
> >>
> >>> IIRC, Fequal throwing a signal at this point caused a livelock, so we
> >>> needed a stricter check. I'll look into it again to see whether
> >>> there's a better alternative.
> >>
> >> This was eight weeks ago, and as far as I can tell, the patch (which
> >> looks sensible) wasn't applied.  Has there been any further progress
> >> here?
> >
> > And that was 44 weeks ago.  :-)  The patch still applies.
> 
> I've now applied the patch, but I moved the test suite to test/manual --
> they call `image-size', which requires a frame to be present...  which
> isn't the case when running "make test", unfortunately.

Hi, this patch appears to have broken something (in NS at least) and
now interactively resizing an image no longer causes the image to be
immediately redisplayed. I have to force a redisplay some other way
before I see the resized image.
-- 
Alan Third





^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#36403: 27.0.50; Trivial image.c bugs
  2020-08-20 23:03                   ` Alan Third
@ 2020-08-20 23:13                     ` Lars Ingebrigtsen
  2020-08-20 23:17                       ` Lars Ingebrigtsen
  0 siblings, 1 reply; 20+ messages in thread
From: Lars Ingebrigtsen @ 2020-08-20 23:13 UTC (permalink / raw)
  To: Alan Third; +Cc: 36403, Pip Cet

Alan Third <alan@idiocy.org> writes:

> Hi, this patch appears to have broken something (in NS at least) and
> now interactively resizing an image no longer causes the image to be
> immediately redisplayed. I have to force a redisplay some other way
> before I see the resized image.

Yup.  This patch fixes things for me (on Debian)...

diff --git a/src/image.c b/src/image.c
index 643b3d0a1f..ceb690ed0a 100644
--- a/src/image.c
+++ b/src/image.c
@@ -1633,7 +1633,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
-	&& !equal_lists (img->spec, spec)
+	&& !NILP (Fequal (img->spec, spec))
 	&& img->frame_foreground == FRAME_FOREGROUND_PIXEL (f)
 	&& img->frame_background == FRAME_BACKGROUND_PIXEL (f))
       break;

The equal_lists thing looks sensible, but I guess we do destructive
alterations with +/-, possibly, to equal is the correct thing, not a
list-of-eqs?

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no





^ permalink raw reply related	[flat|nested] 20+ messages in thread

* bug#36403: 27.0.50; Trivial image.c bugs
  2020-08-20 23:13                     ` Lars Ingebrigtsen
@ 2020-08-20 23:17                       ` Lars Ingebrigtsen
  2020-08-20 23:32                         ` Lars Ingebrigtsen
  0 siblings, 1 reply; 20+ messages in thread
From: Lars Ingebrigtsen @ 2020-08-20 23:17 UTC (permalink / raw)
  To: Alan Third; +Cc: 36403, Pip Cet

Lars Ingebrigtsen <larsi@gnus.org> writes:

> The equal_lists thing looks sensible, but I guess we do destructive
> alterations with +/-, possibly, to equal is the correct thing, not a
> list-of-eqs?

That should be "so equal is the correct thing"...

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no





^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#36403: 27.0.50; Trivial image.c bugs
  2020-08-20 23:17                       ` Lars Ingebrigtsen
@ 2020-08-20 23:32                         ` Lars Ingebrigtsen
  2020-08-21  9:26                           ` Pip Cet
  0 siblings, 1 reply; 20+ messages in thread
From: Lars Ingebrigtsen @ 2020-08-20 23:32 UTC (permalink / raw)
  To: Alan Third; +Cc: 36403, Pip Cet

D'oh.  Pip's patch here just had reverse logic -- removing the ! from
before the equal_lists fixes the issue for me, so I've now pushed that
fix.

  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))

I guess the !NILP (Fequal...) idiom tainted the rewrite...

I've often wondered why we use !NILP instead of, like TRUEP or
something.  !NILP doesn't feel very natural.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no






^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#36403: 27.0.50; Trivial image.c bugs
  2020-08-20 23:32                         ` Lars Ingebrigtsen
@ 2020-08-21  9:26                           ` Pip Cet
  2020-08-21 11:26                             ` Lars Ingebrigtsen
  0 siblings, 1 reply; 20+ messages in thread
From: Pip Cet @ 2020-08-21  9:26 UTC (permalink / raw)
  To: Lars Ingebrigtsen; +Cc: Alan Third, 36403

On Thu, Aug 20, 2020 at 11:32 PM Lars Ingebrigtsen <larsi@gnus.org> wrote:
>   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))
>
> I guess the !NILP (Fequal...) idiom tainted the rewrite...

I can confirm it did. However, my stupidity is not a very good
argument for changing Emacs, or all of it would need changing :-)

> I've often wondered why we use !NILP instead of, like TRUEP or
> something.  !NILP doesn't feel very natural.

Paul's suggestion was to use equal () instead of !NILP (Fequal (...)).
I'm against that, because the F in Fequal kind of hints at the
difficulties of using equal, of which there are many: in the current
implementation, it can signal, quit, be asymmetric (signalling for
(equal a b) whereas (equal b a) works), and is susceptible to equality
bombs that take forever to compare.  It cannot call Lisp, yet, but I
wouldn't be surprised if that changes. It's really not a function you
should use from C very often, and using it as a hash table predicate
is often the wrong thing to do.

Replacing !NILP is a better idea, but I'm struggling to come up with a
good name for that. But even a bad name would be an improvement.





^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#36403: 27.0.50; Trivial image.c bugs
  2020-08-21  9:26                           ` Pip Cet
@ 2020-08-21 11:26                             ` Lars Ingebrigtsen
  2022-10-04 13:52                               ` Basil L. Contovounesios via Bug reports for GNU Emacs, the Swiss army knife of text editors
  0 siblings, 1 reply; 20+ messages in thread
From: Lars Ingebrigtsen @ 2020-08-21 11:26 UTC (permalink / raw)
  To: Pip Cet; +Cc: Alan Third, 36403

Pip Cet <pipcet@gmail.com> writes:

> Paul's suggestion was to use equal () instead of !NILP (Fequal (...)).
> I'm against that, because the F in Fequal kind of hints at the
> difficulties of using equal, of which there are many: in the current
> implementation, it can signal, quit, be asymmetric (signalling for
> (equal a b) whereas (equal b a) works), and is susceptible to equality
> bombs that take forever to compare.

Yeah, your equal_lists is better in all ways, I think.  It should be
much faster, too -- Fequal on a list checks whether the string members
are equal, too, which is slow.  So I think this will speed things up if
you have a buffer that displays images where the data comes from a
string (which can be huge) instead of a file.

> Replacing !NILP is a better idea, but I'm struggling to come up with a
> good name for that. But even a bad name would be an improvement.

TRUEP is kinda obvious, isn't it?  Although I guess some people would
object on the grounds that only t is true, while all other non-nil
values are only trueish.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no





^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#36403: 27.0.50; Trivial image.c bugs
  2020-08-21 11:26                             ` Lars Ingebrigtsen
@ 2022-10-04 13:52                               ` Basil L. Contovounesios via Bug reports for GNU Emacs, the Swiss army knife of text editors
  2022-10-04 14:06                                 ` Lars Ingebrigtsen
  0 siblings, 1 reply; 20+ messages in thread
From: Basil L. Contovounesios via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2022-10-04 13:52 UTC (permalink / raw)
  To: Lars Ingebrigtsen; +Cc: Alan Third, 36403, Pip Cet

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

Lars Ingebrigtsen [2020-08-21 13:26 +0200] wrote:

> Pip Cet <pipcet@gmail.com> writes:
>
>> Paul's suggestion was to use equal () instead of !NILP (Fequal (...)).
>> I'm against that, because the F in Fequal kind of hints at the
>> difficulties of using equal, of which there are many: in the current
>> implementation, it can signal, quit, be asymmetric (signalling for
>> (equal a b) whereas (equal b a) works), and is susceptible to equality
>> bombs that take forever to compare.
>
> Yeah, your equal_lists is better in all ways, I think.  It should be
> much faster, too -- Fequal on a list checks whether the string members
> are equal, too, which is slow.  So I think this will speed things up if
> you have a buffer that displays images where the data comes from a
> string (which can be huge) instead of a file.

We now have Fequal again:

  Restore Emacs 27 image cache semantics
  ac341cd629 2020-12-09 00:42:11 +0100
  https://git.sv.gnu.org/cgit/emacs.git/commit/?id=ac341cd629

Which means image-test-circular-specs signals:

  (circular-list (:dummy . #0))

So how important is it to support image specs with circular property
values?  Should the test be marked :expected-result :failed?

Either way, WDYT of the attached minor cleanup?

Thanks,

-- 
Basil


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Touch-up-image-circular-tests.el.patch --]
[-- Type: text/x-diff, Size: 3688 bytes --]

From d22733866d5343b7a5a38ad8dc76312b1b0ed1f5 Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Mon, 3 Oct 2022 23:34:07 +0300
Subject: [PATCH] Touch up image-circular-tests.el

* test/manual/image-circular-tests.el
(image-test-duplicate-keywords, image-test-circular-plist)
(image-test-:type-property-value, image-test-circular-specs): Skip
tests when there is no image support.  Avoid wrapping entire test
bodies in should or should-error; wrap only the relevant forms
within the test body.  Simplify with printed notation in place of
function calls where applicable.  Wrap long docstrings.  (Bug#36403)
---
 test/manual/image-circular-tests.el | 38 ++++++++++++++++-------------
 1 file changed, 21 insertions(+), 17 deletions(-)

diff --git a/test/manual/image-circular-tests.el b/test/manual/image-circular-tests.el
index 1299970f82..df9031664b 100644
--- a/test/manual/image-circular-tests.el
+++ b/test/manual/image-circular-tests.el
@@ -29,6 +29,7 @@
 
 (ert-deftest image-test-duplicate-keywords ()
   "Test that duplicate keywords in an image spec lead to rejection."
+  (skip-unless (display-images-p))
   (should-error (image-size `(image :type xbm :type xbm
                                     :data-width 1 :data-height 1
                                     :data ,(bool-vector t))
@@ -36,33 +37,36 @@ image-test-duplicate-keywords
 
 (ert-deftest image-test-circular-plist ()
   "Test that a circular image spec is rejected."
-  (should-error
-   (let ((l `(image :type xbm :data-width 1 :data-height 1
-                    :data ,(bool-vector t))))
-     (setcdr (last l) '#1=(:invalid . #1#))
-     (image-size l t))))
+  (skip-unless (display-images-p))
+  (let ((spec `(image :type xbm :data-width 1 :data-height 1
+                      :data ,(bool-vector t)
+                      . ,'#1=(:invalid . #1#))))
+    (should-error (image-size spec t))))
 
 (ert-deftest image-test-:type-property-value ()
   "Test that :type is allowed as a property value in an image spec."
+  (skip-unless (display-images-p))
   (should (equal (image-size `(image :dummy :type :type xbm
                                      :data-width 1 :data-height 1
                                      :data ,(bool-vector t))
                              t)
-                 (cons 1 1))))
+                 '(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 :data-width 1 :data-height 1
-                         :data ,(bool-vector 1) :ignored ,circ1))
-          (spec2 `(image :type xbm :data-width 1 :data-height 1
+  "Test with circular image spec property values.
+In particular, test that they do not cause infinite recursion."
+  (skip-unless (display-images-p))
+  ;; Two copies needed to warm up image cache.
+  (let* ((circ1 (list :dummy))
+         (circ2 (list :dummy))
+         (spec1 `(image :type xbm :data-width 1 :data-height 1
+                        :data ,(bool-vector 1) :ignored ,circ1))
+         (spec2 `(image :type xbm :data-width 1 :data-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))))))
+    (setcdr circ1 circ1)
+    (setcdr circ2 circ2)
+    (should (equal (image-size spec1 t) '(1 . 1)))
+    (should (equal (image-size spec2 t) '(1 . 1)))))
 
 (provide 'image-circular-tests)
 ;;; image-circular-tests.el ends here.
-- 
2.35.1


^ permalink raw reply related	[flat|nested] 20+ messages in thread

* bug#36403: 27.0.50; Trivial image.c bugs
  2022-10-04 13:52                               ` Basil L. Contovounesios via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2022-10-04 14:06                                 ` Lars Ingebrigtsen
  2022-10-04 18:05                                   ` Basil L. Contovounesios via Bug reports for GNU Emacs, the Swiss army knife of text editors
  2022-10-14 22:14                                   ` Basil L. Contovounesios via Bug reports for GNU Emacs, the Swiss army knife of text editors
  0 siblings, 2 replies; 20+ messages in thread
From: Lars Ingebrigtsen @ 2022-10-04 14:06 UTC (permalink / raw)
  To: Basil L. Contovounesios; +Cc: Alan Third, 36403, Pip Cet

"Basil L. Contovounesios" <contovob@tcd.ie> writes:

> Which means image-test-circular-specs signals:
>
>   (circular-list (:dummy . #0))
>
> So how important is it to support image specs with circular property
> values?  Should the test be marked :expected-result :failed?

Hm...  don't know.

> -     (setcdr circ1 circ1)
> -     (setcdr circ2 circ2)
> -     (and (equal (image-size spec1 t) (cons 1 1))
> -          (equal (image-size spec2 t) (cons 1 1))))))
> +    (setcdr circ1 circ1)
> +    (setcdr circ2 circ2)
> +    (should (equal (image-size spec1 t) '(1 . 1)))
> +    (should (equal (image-size spec2 t) '(1 . 1)))))

(cons 1 1) is not eq to (cons 1 1), but '(1 . 1) may or may not be eq to
'(1 . 1) (depending on whether compiled or phase of the moon), which may
be why that code is written that way?  But in this case, I can't see how
it would make a difference...





^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#36403: 27.0.50; Trivial image.c bugs
  2022-10-04 14:06                                 ` Lars Ingebrigtsen
@ 2022-10-04 18:05                                   ` Basil L. Contovounesios via Bug reports for GNU Emacs, the Swiss army knife of text editors
  2022-10-14 22:14                                   ` Basil L. Contovounesios via Bug reports for GNU Emacs, the Swiss army knife of text editors
  1 sibling, 0 replies; 20+ messages in thread
From: Basil L. Contovounesios via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2022-10-04 18:05 UTC (permalink / raw)
  To: Lars Ingebrigtsen; +Cc: Alan Third, 36403, Pip Cet

Lars Ingebrigtsen [2022-10-04 16:06 +0200] wrote:

> "Basil L. Contovounesios" <contovob@tcd.ie> writes:
>
>> -     (setcdr circ1 circ1)
>> -     (setcdr circ2 circ2)
>> -     (and (equal (image-size spec1 t) (cons 1 1))
>> -          (equal (image-size spec2 t) (cons 1 1))))))
>> +    (setcdr circ1 circ1)
>> +    (setcdr circ2 circ2)
>> +    (should (equal (image-size spec1 t) '(1 . 1)))
>> +    (should (equal (image-size spec2 t) '(1 . 1)))))
>
> (cons 1 1) is not eq to (cons 1 1), but '(1 . 1) may or may not be eq to
> '(1 . 1) (depending on whether compiled or phase of the moon), which may
> be why that code is written that way?  But in this case, I can't see how
> it would make a difference...

It doesn't matter whether the calls to image-size return the same
object.  What matters is that both calls succeed (that they return the
correct result is also nice I guess, if that's what you're into ;).

-- 
Basil





^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#36403: 27.0.50; Trivial image.c bugs
  2022-10-04 14:06                                 ` Lars Ingebrigtsen
  2022-10-04 18:05                                   ` Basil L. Contovounesios via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2022-10-14 22:14                                   ` Basil L. Contovounesios via Bug reports for GNU Emacs, the Swiss army knife of text editors
  1 sibling, 0 replies; 20+ messages in thread
From: Basil L. Contovounesios via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2022-10-14 22:14 UTC (permalink / raw)
  To: Lars Ingebrigtsen; +Cc: Alan Third, 36403, Pip Cet

Lars Ingebrigtsen [2022-10-04 16:06 +0200] wrote:

> "Basil L. Contovounesios" <contovob@tcd.ie> writes:
>
>> Which means image-test-circular-specs signals:
>>
>>   (circular-list (:dummy . #0))
>>
>> So how important is it to support image specs with circular property
>> values?  Should the test be marked :expected-result :failed?
>
> Hm...  don't know.

I've marked it as :expected-result :failed for now:

Update image-circular-tests.el
f5c6e628ed 2022-10-15 01:10:31 +0300
https://git.sv.gnu.org/cgit/emacs.git/commit/?id=f5c6e628ed

Thanks,

-- 
Basil





^ permalink raw reply	[flat|nested] 20+ messages in thread

end of thread, other threads:[~2022-10-14 22:14 UTC | newest]

Thread overview: 20+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2019-06-27 16:28 bug#36403: 27.0.50; Trivial image.c bugs Pip Cet
2019-06-27 17:40 ` Eli Zaretskii
2019-06-28 15:05   ` Pip Cet
2019-06-28 19:52     ` Eli Zaretskii
2019-07-22  2:55       ` Pip Cet
2019-07-26  6:56         ` Eli Zaretskii
2019-07-28 14:50           ` Pip Cet
2019-09-24 16:26             ` Lars Ingebrigtsen
2020-08-03  7:47               ` Lars Ingebrigtsen
2020-08-18 16:28                 ` Lars Ingebrigtsen
2020-08-20 23:03                   ` Alan Third
2020-08-20 23:13                     ` Lars Ingebrigtsen
2020-08-20 23:17                       ` Lars Ingebrigtsen
2020-08-20 23:32                         ` Lars Ingebrigtsen
2020-08-21  9:26                           ` Pip Cet
2020-08-21 11:26                             ` Lars Ingebrigtsen
2022-10-04 13:52                               ` Basil L. Contovounesios via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-10-04 14:06                                 ` Lars Ingebrigtsen
2022-10-04 18:05                                   ` Basil L. Contovounesios via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-10-14 22:14                                   ` Basil L. Contovounesios via Bug reports for GNU Emacs, the Swiss army knife of text editors

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.