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

[Robert Cochran]

Ikumi Keita <ikumi@ikumi.que.jp> writes:

> Hi Andreas, thanks for your reply.
>
>>>>>> Andreas Schwab <schwab@suse.de> writes:
>> On Jun 05 2018, Ikumi Keita <ikumi@ikumi.que.jp> wrote:
>>> (defun xyz (arg)
>>> "dummy"
>>> ;    (cond ((eq arg nil) ; OK
>>> ;    (cond ((eq arg 'abc) ; OK
>>> ;    (cond ((eq arg 'def) ; OK
>>> (cond ((eq arg 'default) ; NG
>
>> The byte-compiler uses 'default as a magic symbol, which breaks this
>> case.
>
> Does this mean that this behavior is a (new) designed feature of elisp
> and not a bug?
> If so, is it the respoisibility of the authors of the codes to rewrite
> not to use `default' or else to make sure to set
> `byte-compile-cond-use-jump-table' to nil at byte compile?

I for one consider this a bug, for 2 reasons:

1) It's not reasonable to expect a Lisp programmer to just know that
using the symbol default is problematic.

2) It creates diverging behavior between compiled and non-compiled Lisp.

To that end, I've made a small patch to rectify the behavior. Instead of
hardcoding a symbol, it uses gensym to create a unique one. I did a full
build of Emacs, as well as ran 'make check' and had identical results
pre- and post-change, so I'm reasonably sure it's correct.

Comments and corrections are of course welcomed.

HTH,
-- 
~Robert Cochran

GPG Fingerprint - BD0C 5F8B 381C 64F0 F3CE  E7B9 EC9A 872C 41B2 77C2

-----

>From 4a025170b2b293810cf03c964b402963495fe7d7 Mon Sep 17 00:00:00 2001
From: Robert Cochran <robert-git@cochranmail.com>
Date: Wed, 6 Jun 2018 00:31:25 -0700
Subject: [PATCH] Use a gensym for the default case in
 byte-compile-cond-jump-table

* lisp/bytecomp.el (byte-compile-cond-jump-table): Create gensym to
  use as default case symbol
  (byte-compile-cond-jump-table-info): new argument `default-sym'; use
  it when generating default case clause
---
 lisp/emacs-lisp/bytecomp.el | 13 +++++++------
 1 file changed, 7 insertions(+), 6 deletions(-)

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index ad6b5b7ce2..0fedfd0868 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -4092,7 +4092,7 @@ byte-compile-cond-vars
    (and (symbolp obj1) (macroexp-const-p obj2) (cons obj1 obj2))
    (and (symbolp obj2) (macroexp-const-p obj1) (cons obj2 obj1))))
 
-(defun byte-compile-cond-jump-table-info (clauses)
+(defun byte-compile-cond-jump-table-info (clauses default-sym)
   "If CLAUSES is a `cond' form where:
 The condition for each clause is of the form (TEST VAR VALUE).
 VAR is a variable.
@@ -4124,14 +4124,15 @@ 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 default-sym (or body `(,condition))) 
cases)
                             (throw 'break t))
                    (setq ok nil)
                    (throw 'break nil))))))
          (list (cons prev-test prev-var) (nreverse cases)))))
 
 (defun byte-compile-cond-jump-table (clauses)
-  (let* ((table-info (byte-compile-cond-jump-table-info clauses))
+  (let* ((default-sym (gensym "byte-compile--cond-default-sym"))
+         (table-info (byte-compile-cond-jump-table-info clauses default-sym))
          (test (caar table-info))
          (var (cdar table-info))
          (cases (cadr table-info))
@@ -4141,7 +4142,7 @@ byte-compile-cond-jump-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)
+                                        :size (if (assq default-sym cases)
                                                   (1- (length cases))
                                                 (length cases)))
             default-tag (byte-compile-make-tag)
@@ -4175,8 +4176,8 @@ 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))
+      (when (assq default-sym cases)
+        (setq default-case (cadr (assq default-sym cases))
               cases (butlast cases 1)))
 
       (dolist (case cases)
-- 
2.17.1