From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Wed, 1 Sep 2021 08:32:49 +0000 (+0200)
Subject: Fix (setf (map-elt map key) (my-func))
X-Git-Tag: emacs-28.0.90~1240
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=fffcc7ab25021fd9d73d50cf685a77777d38265c;p=emacs.git

Fix (setf (map-elt map key) (my-func))

* lisp/emacs-lisp/map.el (map-elt): Ensure that the value isn't
referenced more than once (bug#50290).
---

diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index 988a62a4e34..77431f0c594 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -119,14 +119,16 @@ or array."
             ((key key) (default default) (testfn testfn))
           (funcall do `(map-elt ,mgetter ,key ,default)
                    (lambda (v)
-                     `(condition-case nil
-                          ;; Silence warnings about the hidden 4th arg.
-                          (with-no-warnings (map-put! ,mgetter ,key ,v ,testfn))
-                        (map-not-inplace
-                         ,(funcall msetter
-                                   `(map-insert ,mgetter ,key ,v))
-                         ;; Always return the value.
-                         ,v))))))))
+                     (macroexp-let2 nil v v
+                       `(condition-case nil
+                            ;; Silence warnings about the hidden 4th arg.
+                            (with-no-warnings
+                              (map-put! ,mgetter ,key ,v ,testfn))
+                          (map-not-inplace
+                           ,(funcall msetter
+                                     `(map-insert ,mgetter ,key ,v))
+                           ;; Always return the value.
+                           ,v)))))))))
    ;; `testfn' is deprecated.
    (advertised-calling-convention (map key &optional default) "27.1"))
   ;; Can't use `cl-defmethod' with `advertised-calling-convention'.
diff --git a/test/lisp/emacs-lisp/map-tests.el b/test/lisp/emacs-lisp/map-tests.el
index 658ed2e7119..c0f0dbc92be 100644
--- a/test/lisp/emacs-lisp/map-tests.el
+++ b/test/lisp/emacs-lisp/map-tests.el
@@ -521,5 +521,14 @@ Evaluate BODY for each created map."
 		   'value2))
     (should (equal (map-elt ht 'key) 'value2))))
 
+(ert-deftest test-setf-map-with-function ()
+  (let ((num 0)
+        (map nil))
+    (setf (map-elt map 'foo)
+          (funcall (lambda ()
+                     (cl-incf num))))
+    ;; Check that the function is only called once.
+    (should (= num 1))))
+
 (provide 'map-tests)
 ;;; map-tests.el ends here