Fix byte compilation of (eq foo 'default)

Backport from master.
Do not use the symbol ‘default’ as a special marker.
Instead, use a value that cannot appear in the program,
improving on a patch proposed by Robert Cochran (Bug#31718#14).
* lisp/emacs-lisp/bytecomp.el (byte-compile--default-val):
New constant.
(byte-compile-cond-jump-table-info)
(byte-compile-cond-jump-table): Use it instead of 'default.
* test/lisp/emacs-lisp/bytecomp-tests.el:
(byte-opt-testsuite-arith-data): Add a test for the bug.
This commit is contained in:
Paul Eggert 2018-06-16 07:44:58 -07:00 committed by Paul Eggert
parent 4753d79331
commit e1284341fd
2 changed files with 23 additions and 10 deletions

View file

@ -4094,6 +4094,8 @@ that suppresses all warnings during execution of BODY."
(and (symbolp obj1) (macroexp-const-p obj2) (cons obj1 obj2))
(and (symbolp obj2) (macroexp-const-p obj1) (cons obj2 obj1))))
(defconst byte-compile--default-val (cons nil nil) "A unique object.")
(defun byte-compile-cond-jump-table-info (clauses)
"If CLAUSES is a `cond' form where:
The condition for each clause is of the form (TEST VAR VALUE).
@ -4126,7 +4128,9 @@ Return a list of the form ((TEST . VAR) ((VALUE BODY) ...))"
(not (assq obj2 cases)))
(push (list (if (consp obj2) (eval obj2) obj2) body) cases)
(if (and (macroexp-const-p condition) condition)
(progn (push (list 'default (or body `(,condition))) cases)
(progn (push (list byte-compile--default-val
(or body `(,condition)))
cases)
(throw 'break t))
(setq ok nil)
(throw 'break nil))))))
@ -4141,11 +4145,12 @@ Return a list of the form ((TEST . VAR) ((VALUE BODY) ...))"
(when (and cases (not (= (length cases) 1)))
;; TODO: Once :linear-search is implemented for `make-hash-table'
;; set it to `t' for cond forms with a small number of cases.
(setq jump-table (make-hash-table :test test
:purecopy t
:size (if (assq 'default cases)
(1- (length cases))
(length cases)))
(setq jump-table (make-hash-table
:test test
:purecopy t
:size (if (assq byte-compile--default-val cases)
(1- (length cases))
(length cases)))
default-tag (byte-compile-make-tag)
donetag (byte-compile-make-tag))
;; The structure of byte-switch code:
@ -4177,9 +4182,10 @@ Return a list of the form ((TEST . VAR) ((VALUE BODY) ...))"
(let ((byte-compile-depth byte-compile-depth))
(byte-compile-goto 'byte-goto default-tag))
(when (assq 'default cases)
(setq default-case (cadr (assq 'default cases))
cases (butlast cases 1)))
(let ((default-match (assq byte-compile--default-val cases)))
(when default-match
(setq default-case (cadr default-match)
cases (butlast cases))))
(dolist (case cases)
(setq tag (byte-compile-make-tag)

View file

@ -286,7 +286,14 @@
(t)))
(let ((a))
(cond ((eq a 'foo) 'incorrect)
('correct))))
('correct)))
;; Bug#31734
(let ((variable 0))
(cond
((eq variable 'default)
(message "equal"))
(t
(message "not equal")))))
"List of expression for test.
Each element will be executed by interpreter and with
bytecompiled code, and their results compared.")