aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorPaul Eggert2018-06-16 07:44:58 -0700
committerPaul Eggert2018-06-16 09:44:05 -0700
commite1284341fdc9a5d9b25339c3d47b02bc35cd8db4 (patch)
treef15a3b9382d6cf1c54a61eff801254a0ba3e2b0c
parent4753d79331f747001ebdbbe9c32b33597daab37f (diff)
downloademacs-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.el24
-rw-r--r--test/lisp/emacs-lisp/bytecomp-tests.el9
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:
4099The condition for each clause is of the form (TEST VAR VALUE). 4101The 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.
291Each element will be executed by interpreter and with 298Each element will be executed by interpreter and with
292bytecompiled code, and their results compared.") 299bytecompiled code, and their results compared.")