mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00
Code Issues Projects Releases Wiki Activity

gv.el and cl-macs.el: Fix bug#57397

Browse source 
* 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.
This commit is contained in:
Stefan Monnier 2022-09-03 22:38:28 -04:00
parent 1d1158397b
commit 2dd1c2ab19
3 changed files with 20 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

2
lisp/emacs-lisp/cl-macs.el
View file

@ -2762,7 +2762,7 @@ Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
(funcall setter vold))) (funcall setter vold)))
binds)))) binds))))
(let* ((binding (car bindings)) (let* ((binding (car bindings))
(place (macroexpand (car binding) macroexpand-all-environment))) (place (car binding)))
(gv-letplace (getter setter) place (gv-letplace (getter setter) place
(macroexp-let2 nil vnew (cadr binding) (macroexp-let2 nil vnew (cadr binding)
(if (symbolp place) (if (symbolp place)

6
lisp/emacs-lisp/gv.el
View file

@ -87,7 +87,11 @@ with a (not necessarily copyable) Elisp expression that returns the value to
set it to. set it to.
DO must return an Elisp expression." DO must return an Elisp expression."
(cond (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))) ((not (consp place)) (signal 'gv-invalid-place (list place)))
(t (t
(let* ((head (car place)) (let* ((head (car place))

15
test/lisp/emacs-lisp/cl-macs-tests.el
View file

@ -539,7 +539,20 @@ collection clause."
((p (gv-synthetic-place cl (lambda (v) `(setcar l ,v))))) ((p (gv-synthetic-place cl (lambda (v) `(setcar l ,v)))))
(cl-incf p))) (cl-incf p)))
l) 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 () (ert-deftest cl-macs-loop-conditional-step-clauses ()
"These tests failed under the initial fixes in #bug#29799." "These tests failed under the initial fixes in #bug#29799."