aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2022-09-03 22:38:28 -0400
committerStefan Monnier2022-09-03 22:38:28 -0400
commit2dd1c2ab19f7fb99ecee60e27e63b2fb045f6970 (patch)
tree07ef5fd76165ec05f4ec43c2a99fec424476779c
parent1d1158397bce41466078e384eed2d1e214e206de (diff)
downloademacs-2dd1c2ab19f7fb99ecee60e27e63b2fb045f6970.tar.gz
emacs-2dd1c2ab19f7fb99ecee60e27e63b2fb045f6970.zip
gv.el and cl-macs.el: Fix bug#57397
* 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.
-rw-r--r--lisp/emacs-lisp/cl-macs.el2
-rw-r--r--lisp/emacs-lisp/gv.el6
-rw-r--r--test/lisp/emacs-lisp/cl-macs-tests.el15
3 files changed, 20 insertions, 3 deletions
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index edd633675dc..9755c2636de 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2762,7 +2762,7 @@ Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
2762 (funcall setter vold))) 2762 (funcall setter vold)))
2763 binds)))) 2763 binds))))
2764 (let* ((binding (car bindings)) 2764 (let* ((binding (car bindings))
2765 (place (macroexpand (car binding) macroexpand-all-environment))) 2765 (place (car binding)))
2766 (gv-letplace (getter setter) place 2766 (gv-letplace (getter setter) place
2767 (macroexp-let2 nil vnew (cadr binding) 2767 (macroexp-let2 nil vnew (cadr binding)
2768 (if (symbolp place) 2768 (if (symbolp place)
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index eaab6439adb..1db9d96d999 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -87,7 +87,11 @@ with a (not necessarily copyable) Elisp expression that returns the value to
87set it to. 87set it to.
88DO must return an Elisp expression." 88DO must return an Elisp expression."
89 (cond 89 (cond
90 ((symbolp place) (funcall do place (lambda (v) `(setq ,place ,v)))) 90 ((symbolp place)
91 (let ((me (macroexpand-1 place macroexpand-all-environment)))
92 (if (eq me place)
93 (funcall do place (lambda (v) `(setq ,place ,v)))
94 (gv-get me do))))
91 ((not (consp place)) (signal 'gv-invalid-place (list place))) 95 ((not (consp place)) (signal 'gv-invalid-place (list place)))
92 (t 96 (t
93 (let* ((head (car place)) 97 (let* ((head (car place))
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el
index 19ede627a13..2a647e08305 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -539,7 +539,20 @@ collection clause."
539 ((p (gv-synthetic-place cl (lambda (v) `(setcar l ,v))))) 539 ((p (gv-synthetic-place cl (lambda (v) `(setcar l ,v)))))
540 (cl-incf p))) 540 (cl-incf p)))
541 l) 541 l)
542 '(1)))) 542 '(1)))
543 ;; Make sure `gv-synthetic-place' isn't macro-expanded before
544 ;; `cl-letf' gets to see its `gv-expander'.
545 (should (equal
546 (condition-case err
547 (let ((x 1))
548 (list x
549 (cl-letf (((gv-synthetic-place (+ 1 2)
550 (lambda (v) `(setq x ,v)))
551 7))
552 x)
553 x))
554 (error err))
555 '(1 7 3))))
543 556
544(ert-deftest cl-macs-loop-conditional-step-clauses () 557(ert-deftest cl-macs-loop-conditional-step-clauses ()
545 "These tests failed under the initial fixes in #bug#29799." 558 "These tests failed under the initial fixes in #bug#29799."