mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-05-30 09:12:58 -07:00
Code Issues Projects Releases Wiki Activity

Compile closures that modify their bound vars correctly (Bug#46834)

Browse source 
* lisp/emacs-lisp/bytecomp.el (byte-compile--reify-function): Don't
move let bindings into the lambda. Don't reverse list of
bindings. (byte-compile): Evaluate the return value if it was
previously reified.
* test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-reify-function):
Add tests.
This commit is contained in:
Pip Cet 2021-02-28 19:43:09 +00:00
parent b9cb3b9040
commit 2b069c67d7
2 changed files with 46 additions and 23 deletions
Download patch file Download diff file Expand all files Collapse all files

46
lisp/emacs-lisp/bytecomp.el
View file

@ -2785,16 +2785,12 @@ FUN should be either a `lambda' value or a `closure' value."
(dolist (binding env)
(cond
((consp binding)
;; We check shadowing by the args, so that the `let' can be moved
;; within the lambda, which can then be unfolded. FIXME: Some of those
;; bindings might be unused in `body'.
(unless (memq (car binding) args) ;Shadowed.
(push `(,(car binding) ',(cdr binding)) renv)))
(push `(,(car binding) ',(cdr binding)) renv))
((eq binding t))
(t (push `(defvar ,binding) body))))
(if (null renv)
`(lambda ,args ,@preamble ,@body)
`(lambda ,args ,@preamble (let ,(nreverse renv) ,@body)))))
`(let ,renv (lambda ,args ,@preamble ,@body)))))
;;;###autoload
(defun byte-compile (form)
@ -2819,23 +2815,27 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(if (symbolp form) form "provided"))
fun)
(t
(when (or (symbolp form) (eq (car-safe fun) 'closure))
;; `fun' is a function *value*, so try to recover its corresponding
;; source code.
(setq lexical-binding (eq (car fun) 'closure))
(setq fun (byte-compile--reify-function fun)))
;; Expand macros.
(setq fun (byte-compile-preprocess fun))
(setq fun (byte-compile-top-level fun nil 'eval))
(if (symbolp form)
;; byte-compile-top-level returns an *expression* equivalent to the
;; `fun' expression, so we need to evaluate it, tho normally
;; this is not needed because the expression is just a constant
;; byte-code object, which is self-evaluating.
(setq fun (eval fun t)))
(if macro (push 'macro fun))
(if (symbolp form) (fset form fun))
fun))))))
(let (final-eval)
(when (or (symbolp form) (eq (car-safe fun) 'closure))
;; `fun' is a function *value*, so try to recover its corresponding
;; source code.
(setq lexical-binding (eq (car fun) 'closure))
(setq fun (byte-compile--reify-function fun))
(setq final-eval t))
;; Expand macros.
(setq fun (byte-compile-preprocess fun))
(setq fun (byte-compile-top-level fun nil 'eval))
(if (symbolp form)
;; byte-compile-top-level returns an *expression* equivalent to the
;; `fun' expression, so we need to evaluate it, tho normally
;; this is not needed because the expression is just a constant
;; byte-code object, which is self-evaluating.
(setq fun (eval fun t)))
(if final-eval
(setq fun (eval fun t)))
(if macro (push 'macro fun))
(if (symbolp form) (fset form fun))
fun)))))))
(defun byte-compile-sexp (sexp)
"Compile and return SEXP."

23
test/lisp/emacs-lisp/bytecomp-tests.el
View file

@ -1199,6 +1199,29 @@ interpreted and compiled."
(should (equal (funcall (eval fun t)) '(c d)))
(should (equal (funcall (byte-compile fun)) '(c d))))))
(ert-deftest bytecomp-reify-function ()
"Check that closures that modify their bound variables are
compiled correctly."
(cl-letf ((lexical-binding t)
((symbol-function 'counter) nil))
(let ((x 0))
(defun counter () (cl-incf x))
(should (equal (counter) 1))
(should (equal (counter) 2))
;; byte compiling should not cause counter to always return the
;; same value (bug#46834)
(byte-compile 'counter)
(should (equal (counter) 3))
(should (equal (counter) 4)))
(let ((x 0))
(let ((x 1))
(defun counter () x)
(should (equal (counter) 1))
;; byte compiling should not cause the outer binding to shadow
;; the inner one (bug#46834)
(byte-compile 'counter)
(should (equal (counter) 1))))))
;; Local Variables:
;; no-byte-compile: t
;; End: