]> git.eshelyaron.com Git - emacs.git/commitdiff
gv.el and cl-macs.el: Fix bug#57397
authorStefan Monnier <monnier@iro.umontreal.ca>
Sun, 4 Sep 2022 02:38:28 +0000 (22:38 -0400)
committerStefan Monnier <monnier@iro.umontreal.ca>
Sun, 4 Sep 2022 02:38:28 +0000 (22:38 -0400)
* lisp/emacs-lisp/gv.el (gv-get): Obey symbol macros.
* lisp/emacs-lisp/cl-macs.el (cl--letf): Remove workaround placed to
try and handle symbol macros.

* test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs-test--symbol-macrolet):
Add new testcase.

lisp/emacs-lisp/cl-macs.el
lisp/emacs-lisp/gv.el
test/lisp/emacs-lisp/cl-macs-tests.el

index edd633675dc6a8b402fafb8a737949b4ef30838b..9755c2636debfee022ea8a6354a1d7c4793e188d 100644 (file)
@@ -2762,7 +2762,7 @@ Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
                            (funcall setter vold)))
                        binds))))
     (let* ((binding (car bindings))
-           (place (macroexpand (car binding) macroexpand-all-environment)))
+           (place (car binding)))
       (gv-letplace (getter setter) place
         (macroexp-let2 nil vnew (cadr binding)
           (if (symbolp place)
index eaab6439adb6861657e5de1795f30d6d63ca4ca4..1db9d96d99988e957331b8cca02b97d415d24616 100644 (file)
@@ -87,7 +87,11 @@ with a (not necessarily copyable) Elisp expression that returns the value to
 set it to.
 DO must return an Elisp expression."
   (cond
-   ((symbolp place) (funcall do place (lambda (v) `(setq ,place ,v))))
+   ((symbolp place)
+    (let ((me (macroexpand-1 place macroexpand-all-environment)))
+      (if (eq me place)
+          (funcall do place (lambda (v) `(setq ,place ,v)))
+        (gv-get me do))))
    ((not (consp place)) (signal 'gv-invalid-place (list place)))
    (t
     (let* ((head (car place))
index 19ede627a13008d41c20465ab6d73b33ab43e2cb..2a647e08305b7c4a378a8c1d1cbd899c89308d2d 100644 (file)
@@ -539,7 +539,20 @@ collection clause."
                          ((p (gv-synthetic-place cl (lambda (v) `(setcar l ,v)))))
                        (cl-incf p)))
                    l)
-                 '(1))))
+                 '(1)))
+  ;; Make sure `gv-synthetic-place' isn't macro-expanded before
+  ;; `cl-letf' gets to see its `gv-expander'.
+  (should (equal
+           (condition-case err
+               (let ((x 1))
+                 (list x
+                       (cl-letf (((gv-synthetic-place (+ 1 2)
+                                                      (lambda (v) `(setq x ,v)))
+                                  7))
+                         x)
+                       x))
+             (error err))
+           '(1 7 3))))
 
 (ert-deftest cl-macs-loop-conditional-step-clauses ()
   "These tests failed under the initial fixes in #bug#29799."