From 8438bc036bb60622c5c2e03582ba2cf471baf998 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Fri, 17 May 2019 11:25:06 +0200 Subject: [PATCH] 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. --- lisp/emacs-lisp/bytecomp.el | 13 +++--- test/lisp/emacs-lisp/bytecomp-tests.el | 55 +++++++++++++++++++++++++- 2 files changed, 60 insertions(+), 8 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index e76baf5ed0..ce348ed313 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4091,8 +4091,8 @@ byte-compile-cond-vars ;; 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 @@ byte-compile-cond-jump-table-info (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))) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 5fb64ff288..0c5f8e7250 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -27,6 +27,7 @@ (require 'ert) (require 'cl-lib) +(require 'subr-x) (require 'bytecomp) ;;; Code: @@ -296,7 +297,21 @@ byte-opt-testsuite-arith-data ((eq variable 'default) (message "equal")) (t - (message "not equal"))))) + (message "not equal")))) + ;; Bug#35770 + (let ((x 'a)) (cond ((eq x 'a) 'correct) + ((eq x 'b) 'incorrect) + ((eq x 'a) 'incorrect) + ((eq x 'c) 'incorrect))) + (let ((x #x10000000000000000)) + (cond ((eql x #x10000000000000000) 'correct) + ((eql x #x10000000000000001) 'incorrect) + ((eql x #x10000000000000000) 'incorrect) + ((eql x #x10000000000000002) 'incorrect))) + (let ((x "a")) (cond ((equal x "a") 'correct) + ((equal x "b") 'incorrect) + ((equal x "a") 'incorrect) + ((equal x "c") 'incorrect)))) "List of expression for test. Each element will be executed by interpreter and with bytecompiled code, and their results compared.") @@ -613,6 +628,44 @@ bytecomp-tests--with-temp-file (if (buffer-live-p byte-compile-log-buffer) (kill-buffer byte-compile-log-buffer))))) +(ert-deftest bytecomp-test--switch-duplicates () + "Check that duplicates in switches are eliminated correctly (bug#35770)." + (dolist (params + '(((lambda (x) + (cond ((eq x 'a) 111) + ((eq x 'b) 222) + ((eq x 'a) 333) + ((eq x 'c) 444))) + (a b c) + (lambda (u v) (string< (symbol-name u) (symbol-name v)))) + ((lambda (x) + (cond ((eql x #x10000000000000000) 111) + ((eql x #x10000000000000001) 222) + ((eql x #x10000000000000000) 333) + ((eql x #x10000000000000002) 444))) + (#x10000000000000000 #x10000000000000001 #x10000000000000002) + <) + ((lambda (x) + (cond ((equal x "a") 111) + ((equal x "b") 222) + ((equal x "a") 333) + ((equal x "c") 444))) + ("a" "b" "c") + string<))) + (let* ((lisp (nth 0 params)) + (keys (nth 1 params)) + (lessp (nth 2 params)) + (bc (byte-compile lisp)) + (lap (byte-decompile-bytecode (aref bc 1) (aref bc 2))) + ;; Assume the first constant is the switch table. + (table (cadr (assq 'byte-constant lap)))) + (should (hash-table-p table)) + (should (equal (sort (hash-table-keys table) lessp) keys)) + (should (member '(byte-constant 111) lap)) + (should (member '(byte-constant 222) lap)) + (should-not (member '(byte-constant 333) lap)) + (should (member '(byte-constant 444) lap))))) + ;; Local Variables: ;; no-byte-compile: t ;; End: -- 2.20.1