summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp/bytecomp.el
diff options
context:
space:
mode:
authorMattias EngdegÄrd <mattiase@acm.org>2019-05-17 11:25:06 +0200
committerMattias EngdegÄrd <mattiase@acm.org>2019-05-27 13:25:27 +0200
commit68b374a62d8b7b98fd0b144ae83077d698e20bdb (patch)
treee67783a51e27c314b7ddbc734b865beba0c8913a /lisp/emacs-lisp/bytecomp.el
parent457b02440510a594e3ff6f17cc6846a3a467a6a1 (diff)
downloademacs-68b374a62d8b7b98fd0b144ae83077d698e20bdb.tar.gz
Correctly eliminate duplicate cases in switch compilation
Fix code mistakes that prevented the correct elimination of duplicated cases when compiling a `cond' form to a switch bytecode, as in (cond ((eq x 'a) 1) ((eq x 'b) 2) ((eq x 'a) 3) ; should be elided ((eq x 'c) 4)) Sometimes, this caused the bytecode to use the wrong branch (bug#35770). * lisp/emacs-lisp/bytecomp.el (byte-compile-cond-vars): Return obj2 eval'ed. (byte-compile-cond-jump-table-info): Discard redundant condition. Use `obj2' as evaluated. Discard duplicated cases instead of failing the table generation. * test/lisp/emacs-lisp/bytecomp-tests.el (toplevel): Require subr-x. (byte-opt-testsuite-arith-data, bytecomp-test--switch-duplicates): Test.
Diffstat (limited to 'lisp/emacs-lisp/bytecomp.el')
-rw-r--r--lisp/emacs-lisp/bytecomp.el13
1 files changed, 6 insertions, 7 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index e76baf5ed0d..ce348ed3131 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -4091,8 +4091,8 @@ that suppresses all warnings during execution of BODY."
;; and the other is a constant expression whose value can be
;; compared with `eq' (with `macroexp-const-p').
(or
- (and (symbolp obj1) (macroexp-const-p obj2) (cons obj1 obj2))
- (and (symbolp obj2) (macroexp-const-p obj1) (cons obj2 obj1))))
+ (and (symbolp obj1) (macroexp-const-p obj2) (cons obj1 (eval obj2)))
+ (and (symbolp obj2) (macroexp-const-p obj1) (cons obj2 (eval obj1)))))
(defconst byte-compile--default-val (cons nil nil) "A unique object.")
@@ -4121,12 +4121,11 @@ Return a list of the form ((TEST . VAR) ((VALUE BODY) ...))"
(unless prev-test
(setq prev-test test))
(if (and obj1 (memq test '(eq eql equal))
- (consp condition)
(eq test prev-test)
- (eq obj1 prev-var)
- ;; discard duplicate clauses
- (not (assq obj2 cases)))
- (push (list (if (consp obj2) (eval obj2) obj2) body) cases)
+ (eq obj1 prev-var))
+ ;; discard duplicate clauses
+ (unless (assoc obj2 cases test)
+ (push (list obj2 body) cases))
(if (and (macroexp-const-p condition) condition)
(progn (push (list byte-compile--default-val
(or body `(,condition)))