diff options
| author | Paul Eggert | 2018-06-16 07:44:58 -0700 |
|---|---|---|
| committer | Paul Eggert | 2018-06-16 09:44:05 -0700 |
| commit | e1284341fdc9a5d9b25339c3d47b02bc35cd8db4 (patch) | |
| tree | f15a3b9382d6cf1c54a61eff801254a0ba3e2b0c | |
| parent | 4753d79331f747001ebdbbe9c32b33597daab37f (diff) | |
| download | emacs-e1284341fdc9a5d9b25339c3d47b02bc35cd8db4.tar.gz emacs-e1284341fdc9a5d9b25339c3d47b02bc35cd8db4.zip | |
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.
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 24 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/bytecomp-tests.el | 9 |
2 files changed, 23 insertions, 10 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index d1119e10903..68e2fd1d104 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el | |||
| @@ -4094,6 +4094,8 @@ that suppresses all warnings during execution of BODY." | |||
| 4094 | (and (symbolp obj1) (macroexp-const-p obj2) (cons obj1 obj2)) | 4094 | (and (symbolp obj1) (macroexp-const-p obj2) (cons obj1 obj2)) |
| 4095 | (and (symbolp obj2) (macroexp-const-p obj1) (cons obj2 obj1)))) | 4095 | (and (symbolp obj2) (macroexp-const-p obj1) (cons obj2 obj1)))) |
| 4096 | 4096 | ||
| 4097 | (defconst byte-compile--default-val (cons nil nil) "A unique object.") | ||
| 4098 | |||
| 4097 | (defun byte-compile-cond-jump-table-info (clauses) | 4099 | (defun byte-compile-cond-jump-table-info (clauses) |
| 4098 | "If CLAUSES is a `cond' form where: | 4100 | "If CLAUSES is a `cond' form where: |
| 4099 | The condition for each clause is of the form (TEST VAR VALUE). | 4101 | 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) ...))" | |||
| 4126 | (not (assq obj2 cases))) | 4128 | (not (assq obj2 cases))) |
| 4127 | (push (list (if (consp obj2) (eval obj2) obj2) body) cases) | 4129 | (push (list (if (consp obj2) (eval obj2) obj2) body) cases) |
| 4128 | (if (and (macroexp-const-p condition) condition) | 4130 | (if (and (macroexp-const-p condition) condition) |
| 4129 | (progn (push (list 'default (or body `(,condition))) cases) | 4131 | (progn (push (list byte-compile--default-val |
| 4132 | (or body `(,condition))) | ||
| 4133 | cases) | ||
| 4130 | (throw 'break t)) | 4134 | (throw 'break t)) |
| 4131 | (setq ok nil) | 4135 | (setq ok nil) |
| 4132 | (throw 'break nil)))))) | 4136 | (throw 'break nil)))))) |
| @@ -4141,11 +4145,12 @@ Return a list of the form ((TEST . VAR) ((VALUE BODY) ...))" | |||
| 4141 | (when (and cases (not (= (length cases) 1))) | 4145 | (when (and cases (not (= (length cases) 1))) |
| 4142 | ;; TODO: Once :linear-search is implemented for `make-hash-table' | 4146 | ;; TODO: Once :linear-search is implemented for `make-hash-table' |
| 4143 | ;; set it to `t' for cond forms with a small number of cases. | 4147 | ;; set it to `t' for cond forms with a small number of cases. |
| 4144 | (setq jump-table (make-hash-table :test test | 4148 | (setq jump-table (make-hash-table |
| 4145 | :purecopy t | 4149 | :test test |
| 4146 | :size (if (assq 'default cases) | 4150 | :purecopy t |
| 4147 | (1- (length cases)) | 4151 | :size (if (assq byte-compile--default-val cases) |
| 4148 | (length cases))) | 4152 | (1- (length cases)) |
| 4153 | (length cases))) | ||
| 4149 | default-tag (byte-compile-make-tag) | 4154 | default-tag (byte-compile-make-tag) |
| 4150 | donetag (byte-compile-make-tag)) | 4155 | donetag (byte-compile-make-tag)) |
| 4151 | ;; The structure of byte-switch code: | 4156 | ;; The structure of byte-switch code: |
| @@ -4177,9 +4182,10 @@ Return a list of the form ((TEST . VAR) ((VALUE BODY) ...))" | |||
| 4177 | (let ((byte-compile-depth byte-compile-depth)) | 4182 | (let ((byte-compile-depth byte-compile-depth)) |
| 4178 | (byte-compile-goto 'byte-goto default-tag)) | 4183 | (byte-compile-goto 'byte-goto default-tag)) |
| 4179 | 4184 | ||
| 4180 | (when (assq 'default cases) | 4185 | (let ((default-match (assq byte-compile--default-val cases))) |
| 4181 | (setq default-case (cadr (assq 'default cases)) | 4186 | (when default-match |
| 4182 | cases (butlast cases 1))) | 4187 | (setq default-case (cadr default-match) |
| 4188 | cases (butlast cases)))) | ||
| 4183 | 4189 | ||
| 4184 | (dolist (case cases) | 4190 | (dolist (case cases) |
| 4185 | (setq tag (byte-compile-make-tag) | 4191 | (setq tag (byte-compile-make-tag) |
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 13df5912eef..f93c3bdc40f 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el | |||
| @@ -286,7 +286,14 @@ | |||
| 286 | (t))) | 286 | (t))) |
| 287 | (let ((a)) | 287 | (let ((a)) |
| 288 | (cond ((eq a 'foo) 'incorrect) | 288 | (cond ((eq a 'foo) 'incorrect) |
| 289 | ('correct)))) | 289 | ('correct))) |
| 290 | ;; Bug#31734 | ||
| 291 | (let ((variable 0)) | ||
| 292 | (cond | ||
| 293 | ((eq variable 'default) | ||
| 294 | (message "equal")) | ||
| 295 | (t | ||
| 296 | (message "not equal"))))) | ||
| 290 | "List of expression for test. | 297 | "List of expression for test. |
| 291 | Each element will be executed by interpreter and with | 298 | Each element will be executed by interpreter and with |
| 292 | bytecompiled code, and their results compared.") | 299 | bytecompiled code, and their results compared.") |