bug#35285: 27.0.50; Bug in image--set-property; setf

bug#35285: 27.0.50; Bug in image--set-property; setf

[Adam Sjøgren]

Xu Chunyang analysed the problem with setf I presented on
emacs.stackexchange.com¹ as so:

  There is a bug in image--set-property, (setcdr image (cddr image))
  should be (setcdr image (cdddr image)), i.e., change cddr into cdddr

The problem can be seen by doing something like this:

  (defun my-fetch-image (url)
    "Retun filename of image downloaded from url"
    (url-copy-file url "/tmp/test.jpg")
    (create-image "/tmp/test.jpg"))

  (setq my-image (my-fetch-image "https://koldfront.dk/photo/pics/2018/09/snapshot-22-142810-s.jpg"))

and then trying to remove the :width and :height properties from
my-image:

  (setf (image-property my-image :width) nil)
  (setf (image-property my-image :height) nil)

The resulting my-image object looks like this:

  (image :type imagemagick :file "/tmp/test.jpg" :scale 1.2019047619047618 288 :height 400)

where the expected outcome was:

  (image :type imagemagick :file "/tmp/test.jpg" :scale 1.2019047619047618)

Note that only ":width" is removed, not the value of that property
"288".

More details on the emacs.stackexchange.com question.

¹ https://emacs.stackexchange.com/questions/48907/how-do-i-remove-width-and-height-from-an-image-created-with-create-image/48908


In GNU Emacs 27.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.24.5)
 of 2019-04-10 built on tullinup
Repository revision: 0cef057b02b088ded8b46e3453ac0d891888423a
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.12000000
System Description: Debian GNU/Linux buster/sid

Recent messages:
Quit
Configured using:
 'configure --without-pop --with-imagemagick'

Configured features:
XPM JPEG TIFF GIF PNG RSVG IMAGEMAGICK SOUND GPM DBUS GSETTINGS GLIB
NOTIFY INOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE M17N_FLT LIBOTF
XFT ZLIB TOOLKIT_SCROLL_BARS GTK3 X11 XDBE XIM THREADS LIBSYSTEMD
PDUMPER LCMS2 GMP

Important settings:
  value of $LANG: en_GB.UTF-8
  locale-coding-system: utf-8-unix

Major mode: Group

Minor modes in effect:
  gnus-topic-mode: t
  gnus-undo-mode: t
  pixel-scroll-mode: t
  engine-mode: t
  global-magit-file-mode: t
  magit-auto-revert-mode: t
  global-git-commit-mode: t
  dumb-jump-mode: t
  which-function-mode: t
  global-auto-complete-mode: t
  shell-dirtrack-mode: t
  save-place-mode: t
  jabber-activity-mode: t
  winner-mode: t
  tooltip-mode: t
  global-eldoc-mode: t
  electric-indent-mode: t
  mouse-wheel-mode: t
  menu-bar-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t
  buffer-read-only: t
  line-number-mode: t

Load-path shadows:
/usr/share/emacs/site-lisp/elpa-src/ess-18.10.2/debian-autoloads hides /usr/share/emacs/site-lisp/elpa-src/dpkg-dev-el-37.0/debian-autoloads
~/elisp/with-editor/with-editor hides ~/elisp/extra/with-editor
~/elisp/with-editor/with-editor-autoloads hides ~/elisp/extra/with-editor-autoloads
/usr/share/emacs/site-lisp/elpa-src/boxquote-2.1/boxquote hides ~/elisp/extra/boxquote
~/elisp/let-alist/let-alist hides ~/elisp/extra/let-alist
~/elisp/let-alist/let-alist hides /usr/src/emacs/lisp/emacs-lisp/let-alist

Features:
(shadow emacsbug compface jka-compr mhtml-mode css-mode-expansions
css-mode smie eww js-mode-expansions js cc-mode-expansions cc-mode
cc-fonts cc-guess cc-menus cc-cmds cc-styles cc-align cc-engine tramp-sh
tramp-cache bbdb-message sendmail nnir gnus-gravatar gravatar sort
gnus-cite smiley shr-color color mm-archive gnus-async gnus-bcklg
gnus-dup gnus-ml gmane gnus-topic bbdb-gnus-aux qp utf-7 imap rfc2104 pp
epa-file network-stream nnml bbdb-gnus bbdb-mua nnnil gnus-demon shr svg
gnus-delay gnus-draft gnus-agent gnus-srvr gnus-score score-mode
nnvirtual nntp gnus-cache nndraft nnmh mail-extr spam spam-stat bbdb-com
gnus-uu yenc gnus-msg gnus-html url-queue help-fns radix-tree url-cache
mm-url bbdb-picture gnus-art mm-uu mml2015 mm-view mml-smime smime dig
gnus-sum gnus-group gnus-undo gnus-fun hashcash gnus-start gnus-cloud
nnimap nnmail mail-source utf7 netrc nnoo gnus-spec gnus-int gnus-range
gnus-win gnus nnheader elec-pair paren cus-start cus-load pixel-scroll
litable engine-mode gitpatch magithub magithub-ci magithub-issue
magithub-cache magithub-core magit-submodule magit-obsolete magit-blame
magit-stash magit-bisect magit-push magit-pull magit-fetch magit-clone
magit-remote magit-commit magit-sequence magit-notes magit-worktree
magit-tag magit-merge magit-branch magit-reset magit-collab ghub-graphql
treepy graphql ghub url-http url-gw nsm url-auth let-alist magit-files
magit-refs magit-status magit magit-repos magit-apply magit-wip
magit-log magit-diff smerge-mode magit-core magit-autorevert autorevert
filenotify magit-process magit-margin magit-mode git-commit recentf
tree-widget magit-git magit-section magit-utils magit-popup vc-git
diff-mode crm log-edit message rmc rfc822 mml mml-sec epa epg gnus-util
rmail rmail-loaddefs text-property-search mm-decode mm-bodies mm-encode
mail-parse rfc2231 rfc2047 rfc2045 mm-util ietf-drums mail-prsvr
mailabbrev mail-utils gmm-utils mailheader pcvs-util with-editor term
disp-table ehelp eshell esh-cmd esh-ext esh-opt esh-proc esh-io esh-arg
esh-module esh-groups esh-util ag vc-svn find-dired dumb-jump f dash s
etags fileloop generator tex-site auto-loads expand-region
cperl-mode-expansions text-mode-expansions html-mode-expansions
er-basic-expansions expand-region-core expand-region-custom which-func
cperl-mode auto-complete-config auto-complete popup cl-extra help-mode
ess-site ess-toolbar ess-mouse mouseme browse-url ess-swv ess-noweb
ess-noweb-font-lock-mode ess-jags-d ess-bugs-l essd-els ess-xls-d
ess-vst-d ess-stata-mode ess-stata-lang cc-vars cc-defs make-regexp
ess-sp6w-d ess-sp5-d ess-sp4-d ess-sas-d ess-sas-l ess-sas-a ess-s4-d
ess-s3-d ess-omg-d ess-omg-l ess-arc-d ess-lsp-l ess-sp6-d ess-dde
ess-sp3-d ess-julia julia-mode ess-r-mode ess-r-flymake rx flymake-proc
flymake warnings thingatpt ess-r-xref xref project ess-trns
ess-r-package ess-r-syntax pcase ess-r-completion ess-roxy ess-rd essddr
noutline outline hideshow ess-s-lang speedbar sb-image ezimage dframe
ess-help info reporter ess-mode ess ess-noweb-mode ess-inf ess-tracebug
easy-mmode ess-generics compile ess-utils ido ess-custom executable
tramp tramp-loaddefs trampver tramp-integration files-x tramp-compat
ucs-normalize shell pcomplete parse-time debian-changelog-mode imenu
add-log dpkg-dev-el saveplace vc vc-dispatcher bbdb derived bbdb-site
timezone bbdb-loaddefs boxquote rect jabber-http-file-upload url
url-proxy url-privacy url-expand url-methods url-history url-cookie
url-domsuf url-util jabber-print-html jabber-otr jabber
jabber-notifications notifications jabber-libnotify dbus jabber-awesome
jabber-osd jabber-wmii jabber-xmessage jabber-festival jabber-sawfish
jabber-ratpoison jabber-tmux jabber-screen jabber-socks5
jabber-ft-server jabber-si-server jabber-ft-client jabber-ft-common
jabber-si-client jabber-si-common jabber-feature-neg jabber-truncate
jabber-time jabber-autoaway time-date jabber-vcard-avatars
jabber-chatstates jabber-events jabber-vcard jabber-avatar mailcap
jabber-activity jabber-watch jabber-modeline advice jabber-ahc-presence
jabber-ahc jabber-version jabber-ourversion jabber-muc-nick-completion
hippie-exp comint ansi-color jabber-browse jabber-search jabber-register
jabber-roster format-spec jabber-presence jabber-muc jabber-bookmarks
jabber-private jabber-muc-nick-coloring hexrgb jabber-widget
jabber-disco wid-edit jabber-chat jabber-history jabber-mam
jabber-chatbuffer jabber-alert jabber-iq jabber-core jabber-console
sgml-mode dom ewoc jabber-keymap jabber-sasl sasl sasl-anonymous
sasl-login sasl-plain fsm jabber-logon jabber-conn srv dns starttls tls
jabber-xml xml jabber-menu jabber-util cl winner ring gnutls puny
find-file-from-selection find-lisp dired dired-loaddefs cap-words
superword subword edmacro kmacro server finder-inf package easymenu
epg-config url-handlers url-parse auth-source cl-seq eieio eieio-core
cl-macs eieio-loaddefs password-cache json subr-x map url-vars seq
byte-opt gv bytecomp byte-compile cconv cl-loaddefs cl-lib mule-util
tooltip eldoc electric uniquify ediff-hook vc-hooks lisp-float-type
mwheel term/x-win x-win term/common-win x-dnd tool-bar dnd fontset image
regexp-opt fringe tabulated-list replace newcomment text-mode elisp-mode
lisp-mode prog-mode register page menu-bar rfn-eshadow isearch timer
select scroll-bar mouse jit-lock font-lock syntax facemenu font-core
term/tty-colors frame cl-generic cham georgian utf-8-lang misc-lang
vietnamese tibetan thai tai-viet lao korean japanese eucjp-ms cp51932
hebrew greek romanian slovak czech european ethiopic indian cyrillic
chinese composite charscript charprop case-table epa-hook jka-cmpr-hook
help simple abbrev obarray minibuffer cl-preloaded nadvice loaddefs
button faces cus-face macroexp files text-properties overlay sha1 md5
base64 format env code-pages mule custom widget hashtable-print-readable
backquote threads dbusbind inotify lcms2 dynamic-setting
system-font-setting font-render-setting move-toolbar gtk x-toolkit x
multi-tty make-network-process emacs)

Memory information:
((conses 16 943873 110857)
 (symbols 48 43805 3)
 (strings 32 274691 17422)
 (string-bytes 1 11990476)
 (vectors 16 80799)
 (vector-slots 8 2441363 216622)
 (floats 8 648 510)
 (intervals 56 2010 295)
 (buffers 992 58))

-- 
 "Everything needs to change.                                 Adam Sjøgren
  And it has to start today."                            asjo@koldfront.dk

bug#35285: 27.0.50; Bug in image--set-property; setf

[Basil L. Contovounesios]

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

tags 35285 patch
quit


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Fix-off-by-one-link-error-in-image-set-property.patch --]
[-- Type: text/x-diff, Size: 3229 bytes --]

From b611408fe29e3e15e002d799dbaf98f813aa7530 Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Wed, 17 Apr 2019 14:24:31 +0100
Subject: [PATCH] Fix off-by-one-link error in image--set-property

* lisp/image.el (image--set-property): Ensure new value is set even
in the unlikely case that the plist is empty.  Fix off-by-one-link
error when deleting a property. (bug#35285)
* test/lisp/image-tests.el: New file.
(image--set-property): New test.
---
 lisp/image.el            |  4 ++--
 test/lisp/image-tests.el | 45 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 47 insertions(+), 2 deletions(-)
 create mode 100644 test/lisp/image-tests.el

diff --git a/lisp/image.el b/lisp/image.el
index 6da3a0b6cd..ba87d7f785 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -454,10 +454,10 @@ image--set-property
         ;; plist.  Decouple plist entries where the key matches
         ;; the property.
         (if (eq (cadr image) property)
-            (setcdr image (cddr image))
+            (setcdr image (cdddr image))
           (setq image (cddr image))))
     ;; Just enter the new value.
-    (plist-put (cdr image) property value))
+    (setcdr image (plist-put (cdr image) property value)))
   value)
 
 (defun image-property (image property)
diff --git a/test/lisp/image-tests.el b/test/lisp/image-tests.el
new file mode 100644
index 0000000000..89b926e629
--- /dev/null
+++ b/test/lisp/image-tests.el
@@ -0,0 +1,45 @@
+;;; image-tests.el --- tests for image.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2019 Free Software Foundation, Inc.
+
+;; 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/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'image)
+
+(ert-deftest image--set-property ()
+  "Test `image--set-property' behavior."
+  (let ((image (list 'image)))
+    ;; Add properties.
+    (setf (image-property image :scale) 1)
+    (should (equal image '(image :scale 1)))
+    (setf (image-property image :width) 8)
+    (should (equal image '(image :scale 1 :width 8)))
+    (setf (image-property image :height) 16)
+    (should (equal image '(image :scale 1 :width 8 :height 16)))
+    ;; Delete properties.
+    (setf (image-property image :type) nil)
+    (should (equal image '(image :scale 1 :width 8 :height 16)))
+    (setf (image-property image :scale) nil)
+    (should (equal image '(image :width 8 :height 16)))
+    (setf (image-property image :height) nil)
+    (should (equal image '(image :width 8)))
+    (setf (image-property image :width) nil)
+    (should (equal image '(image)))))
+
+;;; image-tests.el ends here
-- 
2.20.1


[-- Attachment #3: Type: text/plain, Size: 440 bytes --]


Adam Sjøgren <asjo@koldfront.dk> writes:

> Xu Chunyang analysed the problem with setf I presented on
> emacs.stackexchange.com¹ as so:
>
>   There is a bug in image--set-property, (setcdr image (cddr image))
>   should be (setcdr image (cdddr image)), i.e., change cddr into cdddr

I agree that this is the problem, and the attached patch should fix
that.  Eli, should this go to emacs-26 or master?

Thanks,

-- 
Basil

bug#35285: 27.0.50; Bug in image--set-property; setf

[Eli Zaretskii]

> From: "Basil L. Contovounesios" <contovob@tcd.ie>
> Date: Wed, 17 Apr 2019 14:36:20 +0100
> Cc: 35285@debbugs.gnu.org
> 
> I agree that this is the problem, and the attached patch should fix
> that.  Eli, should this go to emacs-26 or master?

It's okay for emacs-26, but will :scale work there without
Imagemagick?  Why did you need to use :scale in the tests?

bug#35285: 27.0.50; Bug in image--set-property; setf

[Basil L. Contovounesios]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: "Basil L. Contovounesios" <contovob@tcd.ie>
>> Date: Wed, 17 Apr 2019 14:36:20 +0100
>> Cc: 35285@debbugs.gnu.org
>> 
>> I agree that this is the problem, and the attached patch should fix
>> that.  Eli, should this go to emacs-26 or master?
>
> It's okay for emacs-26, but will :scale work there without
> Imagemagick?  Why did you need to use :scale in the tests?

Any property will do, since the test is using a mocked image spec,
and image--set-property is not sensitive to particular properties.

In other words, I did not need to use :scale, but it will work
regardless of Imagemagick.  Is that okay?

Thanks,

-- 
Basil

bug#35285: 27.0.50; Bug in image--set-property; setf

[Eli Zaretskii]

> From: "Basil L. Contovounesios" <contovob@tcd.ie>
> Cc: <asjo@koldfront.dk>,  <35285@debbugs.gnu.org>
> Date: Wed, 17 Apr 2019 18:43:37 +0100
> 
> > It's okay for emacs-26, but will :scale work there without
> > Imagemagick?  Why did you need to use :scale in the tests?
> 
> Any property will do, since the test is using a mocked image spec,
> and image--set-property is not sensitive to particular properties.
> 
> In other words, I did not need to use :scale, but it will work
> regardless of Imagemagick.  Is that okay?

Yes, thanks.

bug#35285: 27.0.50; Bug in image--set-property; setf

[Basil L. Contovounesios]

tags 35285 fixed
close 35285 26.3
quit

Eli Zaretskii <eliz@gnu.org> writes:

>> From: "Basil L. Contovounesios" <contovob@tcd.ie>
>> Cc: <asjo@koldfront.dk>,  <35285@debbugs.gnu.org>
>> Date: Wed, 17 Apr 2019 18:43:37 +0100
>> 
>> > It's okay for emacs-26, but will :scale work there without
>> > Imagemagick?  Why did you need to use :scale in the tests?
>> 
>> Any property will do, since the test is using a mocked image spec,
>> and image--set-property is not sensitive to particular properties.
>> 
>> In other words, I did not need to use :scale, but it will work
>> regardless of Imagemagick.  Is that okay?
>
> Yes, thanks.

Thanks, I pushed to emacs-26[1] and am thus closing this report.

[1: a4ad7bed18]: Fix off-by-one-link error in image--set-property
  2019-04-18 16:07:55 +0100
  https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=a4ad7bed187493c1c230f223b52c71f5c34f7c89

-- 
Basil