From: Mattias Engdegård <mattiase@acm.org>
Date: Wed, 19 Aug 2020 12:59:29 +0000 (+0200)
Subject: Fix cond jump table compilation (bug#42919)
X-Git-Tag: emacs-27.1.90~182
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=5fcb97dabd;p=emacs.git

Fix cond jump table compilation (bug#42919)

This bug affected compilation of

 (cond ((member '(some list) variable) ...) ...)

While equal is symmetric, member is not; in the latter case the
arguments must be a variable and a constant list, in that order.

Reported by Ikumi Keita.

* lisp/emacs-lisp/bytecomp.el (byte-compile--cond-switch-prefix):
Don't treat equality and member predicates in the same way; only
the former are symmetric in their arguments.
* test/lisp/emacs-lisp/bytecomp-tests.el
(byte-opt-testsuite-arith-data): Add test cases.
---

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 5479e6536a3..90745a3a2f3 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -4172,40 +4172,44 @@ Return (TAIL VAR TEST CASES), where:
         (switch-var nil)
         (switch-test 'eq))
     (while (pcase (car clauses)
-             (`((,fn ,expr1 ,expr2) . ,body)
+             (`((,(and fn (or 'eq 'eql 'equal)) ,expr1 ,expr2) . ,body)
               (let* ((vars (byte-compile--cond-vars expr1 expr2))
                      (var (car vars))
                      (value (cdr vars)))
                 (and var (or (eq var switch-var) (not switch-var))
-                     (cond
-                      ((memq fn '(eq eql equal))
+                     (progn
                        (setq switch-var var)
                        (setq switch-test
                              (byte-compile--common-test switch-test fn))
                        (unless (member value keys)
                          (push value keys)
                          (push (cons (list value) (or body '(t))) cases))
-                       t)
-                      ((and (memq fn '(memq memql member))
-                            (listp value)
-                            ;; Require a non-empty body, since the member
-                            ;; function value depends on the switch
-                            ;; argument.
-                            body)
-                       (setq switch-var var)
-                       (setq switch-test
-                             (byte-compile--common-test
-                              switch-test (cdr (assq fn '((memq   . eq)
-                                                          (memql  . eql)
-                                                          (member . equal))))))
-                       (let ((vals nil))
-                         (dolist (elem value)
-                           (unless (funcall fn elem keys)
-                             (push elem vals)))
-                         (when vals
-                           (setq keys (append vals keys))
-                           (push (cons (nreverse vals) body) cases)))
-                       t))))))
+                       t))))
+             (`((,(and fn (or 'memq 'memql 'member)) ,var ,expr) . ,body)
+              (and (symbolp var)
+                   (or (eq var switch-var) (not switch-var))
+                   (macroexp-const-p expr)
+                   ;; Require a non-empty body, since the member
+                   ;; function value depends on the switch argument.
+                   body
+                   (let ((value (eval expr)))
+                     (and (proper-list-p value)
+                          (progn
+                            (setq switch-var var)
+                            (setq switch-test
+                                  (byte-compile--common-test
+                                   switch-test
+                                   (cdr (assq fn '((memq   . eq)
+                                                   (memql  . eql)
+                                                   (member . equal))))))
+                            (let ((vals nil))
+                              (dolist (elem value)
+                                (unless (funcall fn elem keys)
+                                  (push elem vals)))
+                              (when vals
+                                (setq keys (append vals keys))
+                                (push (cons (nreverse vals) body) cases)))
+                            t))))))
       (setq clauses (cdr clauses)))
     ;; Assume that a single switch is cheaper than two or more discrete
     ;; compare clauses.  This could be tuned, possibly taking into
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index a16adfedfb8..3aba9af3e79 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -347,7 +347,20 @@
                                 ((eq x 't) 99)
                                 (t 999))))
             '((a c) (b c) (7 c) (-3 c) (nil nil) (t c) (q c) (r c) (s c)
-              (t c) (x "a") (x "c") (x c) (x d) (x e))))
+              (t c) (x "a") (x "c") (x c) (x d) (x e)))
+
+    (mapcar (lambda (x) (cond ((member '(a . b) x) 1)
+                              ((equal x '(c)) 2)))
+            '(((a . b)) a b (c) (d)))
+    (mapcar (lambda (x) (cond ((memq '(a . b) x) 1)
+                              ((equal x '(c)) 2)))
+            '(((a . b)) a b (c) (d)))
+    (mapcar (lambda (x) (cond ((member '(a b) x) 1)
+                              ((equal x '(c)) 2)))
+            '(((a b)) a b (c) (d)))
+    (mapcar (lambda (x) (cond ((memq '(a b) x) 1)
+                              ((equal x '(c)) 2)))
+            '(((a b)) a b (c) (d))))
   "List of expression for test.
 Each element will be executed by interpreter and with
 bytecompiled code, and their results compared.")