From 7cdb59b37b278d5f3e95b2b5b1b8758defe70acf Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Sun, 28 Feb 2021 19:43:09 +0000 Subject: [PATCH] Compile closures that modify their bound vars correctly (Bug#46834) * lisp/emacs-lisp/bytecomp.el (byte-compile--reify-function): Don't move let bindings into the lambda. Don't reverse list of bindings. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-reify-function): Add tests. --- lisp/emacs-lisp/bytecomp.el | 8 ++------ test/lisp/emacs-lisp/bytecomp-tests.el | 23 +++++++++++++++++++++++ 2 files changed, 25 insertions(+), 6 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index a2fe37a1ee586..7d00b453caf1c 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2785,16 +2785,12 @@ byte-compile--reify-function (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) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index fb84596ad3f40..03c267ccd0fef 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1199,6 +1199,29 @@ bytecomp-local-defvar (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: -- 2.30.1