diff options
| author | Mattias Engdegård <mattiase@acm.org> | 2023-03-02 09:56:59 +0100 |
|---|---|---|
| committer | Mattias Engdegård <mattiase@acm.org> | 2023-03-02 15:47:26 +0100 |
| commit | 828c49ae29fd318547d7bbe4e7fdc65da316e309 (patch) | |
| tree | 3859f77e26d13d7d760ec79b0ce1ab96ca3d77f6 | |
| parent | a1d90e48bb0076e68592d6a6880c28b52e61d219 (diff) | |
| download | emacs-828c49ae29fd318547d7bbe4e7fdc65da316e309.tar.gz | |
Fix `cond` miscompilation bug
This fixes a bug that miscompiled
(cond ... C S1...Sn)
where S1...Sn are switch clauses (that can be compiled into a switch
op) and C a non-switch clause, by tucking on an extra copy of C at the
end. This was a serious wrong-code bug when the condition of C had
side-effects; otherwise it was only a waste of time and space.
* lisp/emacs-lisp/bytecomp.el (byte-compile-cond): Fix.
* test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--test-cases):
Add test case.
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 1 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/bytecomp-tests.el | 9 |
2 files changed, 10 insertions, 0 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 095468ad978..6f3d7a70903 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4590,6 +4590,7 @@ Return (TAIL VAR TEST CASES), where: (if switch-prefix (progn (byte-compile-cond-jump-table (cdr switch-prefix) donetag) + (setq clause nil) (setq clauses (car switch-prefix))) (setq clause (car clauses)) (cond ((or (eq (car clause) t) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index b6dcfeedb0c..10b009a261c 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -757,6 +757,15 @@ inner loops respectively." (bytecomp-test-identity 3) (error 'bad) (:success)) ; empty handler + + ;; `cond' miscompilation bug + (let ((fn (lambda (x) + (let ((y nil)) + (cond ((progn (setq x (1+ x)) (> x 10)) (setq y 'a)) + ((eq x 1) (setq y 'b)) + ((eq x 2) (setq y 'c))) + (list x y))))) + (mapcar fn (bytecomp-test-identity '(0 1 2 3 10 11)))) ) "List of expressions for cross-testing interpreted and compiled code.") |