From 44d7fd3805f5b1e0b571ece007abc466e1b39ba5 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Mattias=20Engdeg=C3=A5rd?= Date: Fri, 4 Aug 2023 11:08:57 +0200 Subject: [PATCH] Don't allow the `eq` and `unbind` byte-ops to commute (bug#65017) * lisp/emacs-lisp/byte-opt.el (byte-after-unwind-ops): Cease sinking `eq` past `unwind`, because that optimised away the let-binding in (let ((symbols-with-pos-enabled nil)) (eq x y)) and `eq` is currently sensitive to `symbols-with-pos-enabled`. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp--eq-symbols-with-pos-enabled): New test. --- lisp/emacs-lisp/byte-opt.el | 7 +++++- test/lisp/emacs-lisp/bytecomp-tests.el | 34 ++++++++++++++++++++++++++ 2 files changed, 40 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index c7d8531a870..12c2bc51b92 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -2141,7 +2141,7 @@ See Info node `(elisp) Integer Basics'." '(byte-constant byte-dup byte-stack-ref byte-stack-set byte-discard byte-discardN byte-discardN-preserve-tos byte-symbolp byte-consp byte-stringp byte-listp byte-numberp byte-integerp - byte-eq byte-not + byte-not byte-cons byte-list1 byte-list2 byte-list3 byte-list4 byte-listN byte-interactive-p) ;; How about other side-effect-free-ops? Is it safe to move an @@ -2149,6 +2149,11 @@ See Info node `(elisp) Integer Basics'." ;; No, it is not, because the unwind-protect forms can alter ;; the inside of the object to which nth would apply. ;; For the same reason, byte-equal was deleted from this list. + ;; + ;; In particular, `byte-eq' isn't here despite `eq' being nominally + ;; pure because it is currently affected by `symbols-with-pos-enabled' + ;; and so cannot be sunk past an unwind op that might end a binding of + ;; that variable. Yes, this is unsatisfactory. "Byte-codes that can be moved past an unbind.") (defconst byte-compile-side-effect-and-error-free-ops diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 593fd117685..246ffff532f 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -2001,6 +2001,40 @@ EXPECTED-POINT BINDINGS (MODES \\='\\='(ruby-mode js-mode python-mode)) \ (backtrace-frame-args frame)) call)))))))))) +(ert-deftest bytecomp--eq-symbols-with-pos-enabled () + ;; Verify that we don't optimise away a binding of + ;; `symbols-with-pos-enabled' around an application of `eq' (bug#65017). + (let* ((sym-with-pos1 (read-positioning-symbols "sym")) + (sym-with-pos2 (read-positioning-symbols " sym")) ; <- space! + (without-pos-eq (lambda (a b) + (let ((symbols-with-pos-enabled nil)) + (eq a b)))) + (without-pos-eq-compiled (byte-compile without-pos-eq)) + (with-pos-eq (lambda (a b) + (let ((symbols-with-pos-enabled t)) + (eq a b)))) + (with-pos-eq-compiled (byte-compile with-pos-eq))) + (dolist (mode '(interpreted compiled)) + (ert-info ((symbol-name mode) :prefix "mode: ") + (ert-info ("disabled" :prefix "symbol-pos: ") + (let ((eq-fn (pcase-exhaustive mode + ('interpreted without-pos-eq) + ('compiled without-pos-eq-compiled)))) + (should (equal (funcall eq-fn 'sym 'sym) t)) + (should (equal (funcall eq-fn sym-with-pos1 'sym) nil)) + (should (equal (funcall eq-fn 'sym sym-with-pos1) nil)) + (should (equal (funcall eq-fn sym-with-pos1 sym-with-pos1) t)) + (should (equal (funcall eq-fn sym-with-pos1 sym-with-pos2) nil)))) + (ert-info ("enabled" :prefix "symbol-pos: ") + (let ((eq-fn (pcase-exhaustive mode + ('interpreted with-pos-eq) + ('compiled with-pos-eq-compiled)))) + (should (equal (funcall eq-fn 'sym 'sym) t)) + (should (equal (funcall eq-fn sym-with-pos1 'sym) t)) + (should (equal (funcall eq-fn 'sym sym-with-pos1) t)) + (should (equal (funcall eq-fn sym-with-pos1 sym-with-pos1) t)) + (should (equal (funcall eq-fn sym-with-pos1 sym-with-pos2) t)))))))) + ;; Local Variables: ;; no-byte-compile: t ;; End: -- 2.39.2