procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix byte compilation of (eq foo 'default)

Browse source 
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 34e257f83a
commit 9af399fd80
2 changed files with 23 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

24
lisp/emacs-lisp/bytecomp.el
View file

@ -4092,6 +4092,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).
@ -4124,7 +4126,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))))))
@ -4139,11 +4143,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:
@ -4175,9 +4180,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)