bug#51982: Erroneous handling of local variables in byte-compiled nested lambdas

["Mattias Engdegård" <mattiase@acm.org>]

[-- Attachment #1: Type: text/plain, Size: 585 bytes --]

20 nov. 2021 kl. 18.22 skrev Paul Pogonyshev <pogonyshev@gmail.com>:

> > you cannot count on an eventual fix to be back-ported to Emacs 28
> 
> Uh, it's not even released yet. Are the stabilization rules so strict that even a *fix* cannot go in? Unless it is going to be a rewrite of half the file...

Sorry, I'd love to have it in 28 but I don't make the rules.

Meanwhile, here's a lightly tested attempt at a fix. I'm not very satisfied by it because it forces an up-front access of a captured variable; I'd rather sink it to each application of the λ-lifted function.


[-- Attachment #2: cconv-bug51982.diff --]
[-- Type: application/octet-stream, Size: 5886 bytes --]

diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 03e109f250..17deb8b90a 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -431,7 +431,8 @@ cconv-convert
                  (let ((closedsym (make-symbol (format "closed-%s" var))))
                    (setq new-env (cconv--remap-llv new-env var closedsym))
                    (setq new-extend (cons closedsym (remq var new-extend)))
-                   (push `(,closedsym ,var) binders-new)))
+                   (let ((var-def (or (cdr (assq var env)) var)))
+                     (push `(,closedsym ,var-def) binders-new))))
 
                ;; We push the element after redefined free variables are
                ;; processed.  This is important to avoid the bug when free
@@ -456,7 +457,8 @@ cconv-convert
                     (closedsym (make-symbol (format "closed-%s" var))))
                (setq new-env (cconv--remap-llv new-env var closedsym))
                (setq new-extend (cons closedsym (remq var new-extend)))
-               (push `(,closedsym ,var) binders-new)))))
+               (let ((var-def (or (cdr (assq var env)) var)))
+                 (push `(,closedsym ,var-def) binders-new))))))
 
        `(,letsym ,(nreverse binders-new)
                  . ,(mapcar (lambda (form)
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index dbc0aa3db4..ed596ef3b4 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -643,6 +643,15 @@ bytecomp-tests--test-cases
 
     (cond)
     (mapcar (lambda (x) (cond ((= x 0)))) '(0 1))
+
+    ;; This gives different results in lexbind and dynbind modes,
+    ;; but in each the compiler and interpreter should agree!
+    (let ((f (lambda (x)
+               (lambda ()
+                 (let ((g (lambda () x)))
+                   (let ((x 'a))
+                     (list x (funcall g))))))))
+      (funcall (funcall f 'b)))
     )
   "List of expressions for cross-testing interpreted and compiled code.")
 
diff --git a/test/lisp/emacs-lisp/cconv-tests.el b/test/lisp/emacs-lisp/cconv-tests.el
index 4290571735..b6a789fcfe 100644
--- a/test/lisp/emacs-lisp/cconv-tests.el
+++ b/test/lisp/emacs-lisp/cconv-tests.el
@@ -205,5 +205,88 @@ cconv-convert-lambda-lifted
            nil 99)
           42)))
 
+(defun cconv-tests--intern-all (x)
+  "Intern all symbols in X."
+  (cond ((symbolp x) (intern (symbol-name x)))
+        ((consp x) (cons (cconv-tests--intern-all (car x))
+                         (cconv-tests--intern-all (cdr x))))
+        ;; Assume we don't need to deal with vectors etc.
+        (t x)))
+
+(ert-deftest cconv-closure-convert-remap-var ()
+  ;; Verify that we correctly remap shadowed lambda-lifted variables.
+
+  ;; We intern all symbols for ease of comparison; this works because
+  ;; the `cconv-closure-convert' result should contain no pair of
+  ;; distinct symbols having the same name.
+
+  ;; Sanity check: captured variable, no lambda-lifting or shadowing:
+  (should (equal (cconv-tests--intern-all
+           (cconv-closure-convert
+            '#'(lambda (x)
+                 #'(lambda () x))))
+           '#'(lambda (x)
+                (internal-make-closure
+                 nil (x) nil
+                 (internal-get-closed-var 0)))))
+
+  ;; Basic case:
+  ;; - with `let':
+  (should (equal (cconv-tests--intern-all
+                  (cconv-closure-convert
+                   '#'(lambda (x)
+                        (let ((f #'(lambda () x)))
+                          (let ((x 'b))
+                            (list x (funcall f)))))))
+                 '#'(lambda (x)
+                      (let ((f #'(lambda (x) x)))
+                        (let ((x 'b)
+                              (closed-x x))
+                          (list x (funcall f closed-x)))))))
+  ;; - with `let*':
+  (should (equal (cconv-tests--intern-all
+                  (cconv-closure-convert
+                   '#'(lambda (x)
+                        (let ((f #'(lambda () x)))
+                          (let* ((x 'b))
+                            (list x (funcall f)))))))
+                 '#'(lambda (x)
+                      (let ((f #'(lambda (x) x)))
+                        (let* ((closed-x x)
+                               (x 'b))
+                          (list x (funcall f closed-x)))))))
+
+  ;; With the lambda-lifted shadowed variable also being captured:
+  ;; - with `let':
+  (should (equal (cconv-tests--intern-all
+                  (cconv-closure-convert
+                   '#'(lambda (x)
+                        #'(lambda ()
+                            (let ((f #'(lambda () x)))
+                              (let ((x 'a))
+                                (list x (funcall f))))))))
+                 '#'(lambda (x)
+                      (internal-make-closure
+                       nil (x) nil
+                       (let ((f #'(lambda (x) x)))
+                         (let ((x 'a)
+                               (closed-x (internal-get-closed-var 0)))
+                           (list x (funcall f closed-x))))))))
+  ;; - with `let*':
+  (should (equal (cconv-tests--intern-all
+                  (cconv-closure-convert
+                   '#'(lambda (x)
+                        #'(lambda ()
+                            (let ((f #'(lambda () x)))
+                              (let* ((x 'a))
+                                (list x (funcall f))))))))
+                 '#'(lambda (x)
+                      (internal-make-closure
+                       nil (x) nil
+                       (let ((f #'(lambda (x) x)))
+                         (let* ((closed-x (internal-get-closed-var 0))
+                                (x 'a))
+                           (list x (funcall f closed-x)))))))))
+
 (provide 'cconv-tests)
 ;;; cconv-tests.el ends here