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

cl-defun/cl-struct: Use static scoping for function args

Browse source 
* lisp/emacs-lisp/cl-macs.el (cl--slet*): New function.
(cl--transform-lambda): Use it to fix bug#47552.

* test/lisp/emacs-lisp/cl-macs-tests.el (cl-&key-arguments): Add test.
This commit is contained in:
Stefan Monnier 2023-06-23 10:45:49 -04:00
parent 01ce70cea9
commit 37a09a4c00
2 changed files with 27 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -243,6 +243,18 @@ The name is made by appending a number to PREFIX, default \"T\"."
(defvar cl--bind-enquote) ;Non-nil if &cl-quote was in the formal arglist!
(defvar cl--bind-lets) (defvar cl--bind-forms)
(defun cl--slet* (bindings body)
"Like `macroexp-let*' but uses static scoping for all the BINDINGS."
(pcase-exhaustive bindings
('() body)
(`((,var ,exp) . ,bindings)
(let ((rest (cl--slet* bindings body)))
(if (macroexp--dynamic-variable-p var)
;; FIXME: We use `identity' to obfuscate the code enough to
;; circumvent the known bug in `macroexp--unfold-lambda' :-(
`(funcall (identity (lambda (,var) ,@(macroexp-unprogn rest))) ,exp)
(macroexp-let* `((,var ,exp)) rest))))))
(defun cl--transform-lambda (form bind-block)
"Transform a function form FORM of name BIND-BLOCK.
BIND-BLOCK is the name of the symbol to which the function will be bound,
@ -337,7 +349,9 @@ FORM is of the form (ARGS . BODY)."
(list '&rest (car (pop cl--bind-lets))))))))
`((,@(nreverse simple-args) ,@rest-args)
,@header
,(macroexp-let* cl--bind-lets
;; Make sure that function arguments are unconditionally statically
;; scoped (bug#47552).
,(cl--slet* cl--bind-lets
(macroexp-progn
`(,@(nreverse cl--bind-forms)
,@body)))))))

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

@ -806,7 +806,15 @@ See Bug#57915."
(ert-deftest cl-&key-arguments ()
(cl-flet ((fn (&key x) x))
(should-error (fn :x))
(should (eq (fn :x :a) :a))))
(should (eq (fn :x :a) :a)))
;; In ELisp function arguments are always statically scoped (bug#47552).
(defvar cl--test-a)
(let ((cl--test-a 'dyn)
;; FIXME: How do we silence the "Lexical argument shadows" warning?
(f (cl-function (lambda (&key cl--test-a b)
(list cl--test-a (symbol-value 'cl--test-a) b)))))
(should (equal (funcall f :cl--test-a 'lex :b 2) '(lex dyn 2)))))
;;; cl-macs-tests.el ends here