procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Don't allow the eq and unbind byte-ops to commute (bug#65017)

Browse source 
* 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.
This commit is contained in:
Mattias Engdegård 2023-08-04 11:08:57 +02:00
parent c75c799719
commit 44d7fd3805
2 changed files with 40 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
lisp/emacs-lisp/byte-opt.el
View file

@ -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

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

@ -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: