bug#31718: 26.1; Strange behavior of `cond'

[Paul Eggert <eggert@cs.ucla.edu>]

[-- Attachment #1: Type: text/plain, Size: 513 bytes --]

Robert, thanks for your June 6 patch in Bug#31718#14. A small problem: gensym 
does not guarantee that the resulting symbol is unique, so the generated symbol 
could in theory appear in the input which would trigger the bug. Instead, let's 
use a guaranteed-unique object (cons nil nil). Also, I wrote a test case for 
this bug.

I installed the attached patch into the master branch. Given the practical 
consequences of this bug I expect the bug fix should be backported into the 
emacs-26 branch too.

[-- Attachment #2: 0001-Fix-byte-compilation-of-eq-foo-default.txt --]
[-- Type: text/plain, Size: 4182 bytes --]

From 9af399fd803ac1ca79f319945b9745b5b96122e7 Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@Penguin.CS.UCLA.EDU>
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