aboutsummaryrefslogtreecommitdiffstats
path: root/test
diff options
context:
space:
mode:
authorMattias EngdegÄrd2019-05-17 11:25:06 +0200
committerMattias EngdegÄrd2019-05-27 13:25:27 +0200
commit68b374a62d8b7b98fd0b144ae83077d698e20bdb (patch)
treee67783a51e27c314b7ddbc734b865beba0c8913a /test
parent457b02440510a594e3ff6f17cc6846a3a467a6a1 (diff)
downloademacs-68b374a62d8b7b98fd0b144ae83077d698e20bdb.tar.gz
emacs-68b374a62d8b7b98fd0b144ae83077d698e20bdb.zip
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 'test')
-rw-r--r--test/lisp/emacs-lisp/bytecomp-tests.el55
1 files changed, 54 insertions, 1 deletions
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index 5fb64ff2881..ed100020def 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -27,6 +27,7 @@
27 27
28(require 'ert) 28(require 'ert)
29(require 'cl-lib) 29(require 'cl-lib)
30(require 'subr-x)
30(require 'bytecomp) 31(require 'bytecomp)
31 32
32;;; Code: 33;;; Code:
@@ -296,7 +297,21 @@
296 ((eq variable 'default) 297 ((eq variable 'default)
297 (message "equal")) 298 (message "equal"))
298 (t 299 (t
299 (message "not equal"))))) 300 (message "not equal"))))
301 ;; Bug#35770
302 (let ((x 'a)) (cond ((eq x 'a) 'correct)
303 ((eq x 'b) 'incorrect)
304 ((eq x 'a) 'incorrect)
305 ((eq x 'c) 'incorrect)))
306 (let ((x #x10000000000000000))
307 (cond ((eql x #x10000000000000000) 'correct)
308 ((eql x #x10000000000000001) 'incorrect)
309 ((eql x #x10000000000000000) 'incorrect)
310 ((eql x #x10000000000000002) 'incorrect)))
311 (let ((x "a")) (cond ((equal x "a") 'correct)
312 ((equal x "b") 'incorrect)
313 ((equal x "a") 'incorrect)
314 ((equal x "c") 'incorrect))))
300 "List of expression for test. 315 "List of expression for test.
301Each element will be executed by interpreter and with 316Each element will be executed by interpreter and with
302bytecompiled code, and their results compared.") 317bytecompiled code, and their results compared.")
@@ -613,6 +628,44 @@ literals (Bug#20852)."
613 (if (buffer-live-p byte-compile-log-buffer) 628 (if (buffer-live-p byte-compile-log-buffer)
614 (kill-buffer byte-compile-log-buffer))))) 629 (kill-buffer byte-compile-log-buffer)))))
615 630
631(ert-deftest bytecomp-test--switch-duplicates ()
632 "Check that duplicates in switches are eliminated correctly (bug#35770)."
633 (dolist (params
634 '(((lambda (x)
635 (cond ((eq x 'a) 111)
636 ((eq x 'b) 222)
637 ((eq x 'a) 333)
638 ((eq x 'c) 444)))
639 (a b c)
640 string<)
641 ((lambda (x)
642 (cond ((eql x #x10000000000000000) 111)
643 ((eql x #x10000000000000001) 222)
644 ((eql x #x10000000000000000) 333)
645 ((eql x #x10000000000000002) 444)))
646 (#x10000000000000000 #x10000000000000001 #x10000000000000002)
647 <)
648 ((lambda (x)
649 (cond ((equal x "a") 111)
650 ((equal x "b") 222)
651 ((equal x "a") 333)
652 ((equal x "c") 444)))
653 ("a" "b" "c")
654 string<)))
655 (let* ((lisp (nth 0 params))
656 (keys (nth 1 params))
657 (lessp (nth 2 params))
658 (bc (byte-compile lisp))
659 (lap (byte-decompile-bytecode (aref bc 1) (aref bc 2)))
660 ;; Assume the first constant is the switch table.
661 (table (cadr (assq 'byte-constant lap))))
662 (should (hash-table-p table))
663 (should (equal (sort (hash-table-keys table) lessp) keys))
664 (should (member '(byte-constant 111) lap))
665 (should (member '(byte-constant 222) lap))
666 (should-not (member '(byte-constant 333) lap))
667 (should (member '(byte-constant 444) lap)))))
668
616;; Local Variables: 669;; Local Variables:
617;; no-byte-compile: t 670;; no-byte-compile: t
618;; End: 671;; End: