master 1247dc87bab: Fix variable aliasing bytecode miscompilation (bug#67116)

[Mattias Engdegård]

branch: master
commit 1247dc87bab7ec56b05e87ab0ae8bf37aa90021b
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    Fix variable aliasing bytecode miscompilation (bug#67116)
    
    The compiler didn't cancel aliasing if the aliased variable was
    modified in a variable binding in the same `let` that created
    the alias.  For example,
    
     (let ((x A))
       (let ((y x)
             (z (setq x B)))
         y))
    
    would incorrectly substitute y->x in the body form despite x being
    already modified at that point, which normally should have cancelled
    the aliasing.
    
    Bug reported by Alan Mackenzie.
    
    * lisp/emacs-lisp/byte-opt.el (byte-optimize--aliased-vars):
    Now an alist that also contains the aliases; update the doc string.
    * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker):
    * lisp/emacs-lisp/byte-opt.el (byte-optimize-let-form):
    Detect aliasing early for `let`-bound variables as well.
    * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--test-cases):
    Add test cases.
---
 lisp/emacs-lisp/byte-opt.el            | 57 ++++++++++++++++------------------
 test/lisp/emacs-lisp/bytecomp-tests.el | 10 ++++++
 2 files changed, 37 insertions(+), 30 deletions(-)

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index ecc5fff3b67..2caaadc9f9e 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -217,10 +217,10 @@ This indicates the loop discovery phase.")
 
 (defvar byte-optimize--aliased-vars nil
   "List of variables which may be aliased by other lexical variables.
-If an entry in `byte-optimize--lexvars' has another variable as its VALUE,
-then that other variable must be in this list.
-This variable thus carries no essential information but is maintained
-for speeding up processing.")
+Each element is (NAME . ALIAS) where NAME is the aliased variable
+and ALIAS the variable record (in the format described for
+`byte-optimize--lexvars') for an alias, which may have NAME as its VALUE.
+There can be multiple entries for the same NAME if it has several aliases.")
 
 (defun byte-optimize--substitutable-p (expr)
   "Whether EXPR is a constant that can be propagated."
@@ -462,13 +462,17 @@ for speeding up processing.")
            (setcar (cdr lexvar) t)    ; Mark variable to be kept.
            (setcdr (cdr lexvar) nil)  ; Inhibit further substitution.
 
-           (when (memq var byte-optimize--aliased-vars)
-             ;; Cancel aliasing of variables aliased to this one.
-             (dolist (v byte-optimize--lexvars)
-               (when (eq (nth 2 v) var)
-                 ;; V is bound to VAR but VAR is now mutated:
-                 ;; cancel aliasing.
-                 (setcdr (cdr v) nil)))))
+           ;; Cancel substitution of variables aliasing this one.
+           (let ((aliased-vars byte-optimize--aliased-vars))
+             (while
+                 (let ((alias (assq var aliased-vars)))
+                   (and alias
+                        (progn
+                          ;; Found a variable bound to VAR but VAR is
+                          ;; now mutated; cancel aliasing.
+                          (setcdr (cddr alias) nil)
+                          (setq aliased-vars (cdr (memq alias aliased-vars)))
+                          t))))))
          `(,fn ,var ,value)))
 
       (`(defvar ,(and (pred symbolp) name) . ,rest)
@@ -587,7 +591,6 @@ for speeding up processing.")
       (let* ((byte-optimize--lexvars byte-optimize--lexvars)
              (byte-optimize--aliased-vars byte-optimize--aliased-vars)
              (new-lexvars nil)
-             (new-aliased-vars nil)
              (let-vars nil)
              (body (cdr form))
              (bindings (car form)))
@@ -597,7 +600,7 @@ for speeding up processing.")
                  (expr (byte-optimize-form (cadr binding) nil)))
             (setq bindings (cdr bindings))
             (when (and (eq head 'let*)
-                       (memq name byte-optimize--aliased-vars))
+                       (assq name byte-optimize--aliased-vars))
               ;; New variable shadows an aliased variable -- α-rename
               ;; it in this and all subsequent bindings.
               (let ((new-name (make-symbol (symbol-name name))))
@@ -610,14 +613,12 @@ for speeding up processing.")
                               bindings))
                 (setq body (byte-optimize--rename-var-body name new-name body))
                 (setq name new-name)))
-            (let* ((aliased nil)
-                   (value (and
-                           (or (byte-optimize--substitutable-p expr)
-                               ;; Aliasing another lexvar.
-                               (setq aliased
-                                     (and (symbolp expr)
-                                          (assq expr byte-optimize--lexvars))))
-                           (list expr)))
+            (let* ((aliased
+                    ;; Aliasing another lexvar.
+                    (and (symbolp expr) (assq expr byte-optimize--lexvars)))
+                   (value (and (or aliased
+                                   (byte-optimize--substitutable-p expr))
+                               (list expr)))
                    (lexical (not (or (special-variable-p name)
                                      (memq name byte-compile-bound-variables)
                                      (memq name byte-optimize--dynamic-vars))))
@@ -626,20 +627,16 @@ for speeding up processing.")
               (when lexinfo
                 (push lexinfo (if (eq head 'let*)
                                   byte-optimize--lexvars
-                                new-lexvars)))
-              (when aliased
-                (push expr (if (eq head 'let*)
-                               byte-optimize--aliased-vars
-                             new-aliased-vars))))))
-
-        (setq byte-optimize--aliased-vars
-              (append new-aliased-vars byte-optimize--aliased-vars))
+                                new-lexvars))
+                (when aliased
+                  (push (cons expr lexinfo) byte-optimize--aliased-vars))))))
+
         (when (and (eq head 'let) byte-optimize--aliased-vars)
           ;; Find new variables that shadow aliased variables.
           (let ((shadowing-vars nil))
             (dolist (lexvar new-lexvars)
               (let ((name (car lexvar)))
-                (when (and (memq name byte-optimize--aliased-vars)
+                (when (and (assq name byte-optimize--aliased-vars)
                            (not (memq name shadowing-vars)))
                   (push name shadowing-vars))))
             ;; α-rename them
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el 
b/test/lisp/emacs-lisp/bytecomp-tests.el
index 06918f5901c..27056c99a50 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -643,6 +643,16 @@ inner loops respectively."
       (funcall (car f) 3)
       (list a b))
 
+    (let ((x (list 1)))
+      (let ((y x)
+            (z (setq x (vector x))))
+        (list x y z)))
+
+    (let ((x (list 1)))
+      (let* ((y x)
+             (z (setq x (vector x))))
+        (list x y z)))
+
     (cond)
     (mapcar (lambda (x) (cond ((= x 0)))) '(0 1))