From e1284341fdc9a5d9b25339c3d47b02bc35cd8db4 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 16 Jun 2018 07:44:58 -0700 Subject: [PATCH] Fix byte compilation of (eq foo 'default) MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit 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. --- lisp/emacs-lisp/bytecomp.el | 24 +++++++++++++++--------- 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." (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) 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 @@ (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.") -- 2.39.2