[Emacs-diffs] emacs-26 e128434: Fix byte compilation of (eq foo 'default)

[Paul Eggert]

branch: emacs-26
commit e1284341fdc9a5d9b25339c3d47b02bc35cd8db4
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>

    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.
---
 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 d1119e1..68e2fd1 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 13df591..f93c3bd 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.")