Commit e1284341 authored by Paul Eggert's avatar Paul Eggert Committed by Paul Eggert

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.
parent 4753d793
......@@ -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.")
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment