diff options
| author | Mattias Engdegård <mattiase@acm.org> | 2019-05-17 11:25:06 +0200 |
|---|---|---|
| committer | Mattias Engdegård <mattiase@acm.org> | 2019-05-27 13:25:27 +0200 |
| commit | 68b374a62d8b7b98fd0b144ae83077d698e20bdb (patch) | |
| tree | e67783a51e27c314b7ddbc734b865beba0c8913a /lisp/emacs-lisp | |
| parent | 457b02440510a594e3ff6f17cc6846a3a467a6a1 (diff) | |
| download | emacs-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')
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 13 |
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))) |