From 9af399fd803ac1ca79f319945b9745b5b96122e7 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=UTF-8 Content-Transfer-Encoding: 8bit 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 ad6b5b7..ee28e61 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4092,6 +4092,8 @@ byte-compile-cond-vars (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 @@ byte-compile-cond-jump-table-info (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 @@ byte-compile-cond-jump-table (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 @@ byte-compile-cond-jump-table (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 7c5aa9a..ba62549 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -289,7 +289,14 @@ byte-opt-testsuite-arith-data (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.7.4