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:
parent
4753d79331
commit
e1284341fd
2 changed files with 23 additions and 10 deletions
|
@ -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)
|
||||
|
|
|
@ -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.")
|
||||
|
|
Loading…
Add table
Reference in a new issue