From: "Mattias Engdegård" <mattiase@acm.org>
To: Stefan Monnier <monnier@iro.umontreal.ca>
Cc: 35770@debbugs.gnu.org, vibhavp@gmail.com
Subject: bug#35770: [PATCH] Broken duplicate case elimination in switch byte-compilation
Date: Fri, 17 May 2019 16:48:19 +0200 [thread overview]
Message-ID: <752237291204505cd6b3fb98f667c2718fa6361f.camel@acm.org> (raw)
In-Reply-To: <jwvftpd46qr.fsf-monnier+emacs@gnu.org>
[-- Attachment #1: Type: text/plain, Size: 629 bytes --]
fre 2019-05-17 klockan 08:16 -0400 skrev Stefan Monnier:
> The patch looks fine, but could you add corresponding regression
> tests?
Added. I wasn't sure how you test these things, but I both added some
functional tests and some kind of check of the bytecode. If you find
the latter superfluous, I can drop it; I think the functional tests are
reliable enough. In other words, we have a case of miscompilation.
There was another bug in the original code which survived into the
first patch: the check for duplicate keys was done with `assq', which
of course doesn't work for stuff compared with `eql' or `equal'. Now
fixed.
[-- Attachment #2: 0001-Correctly-eliminate-duplicate-cases-in-switch-compil.patch --]
[-- Type: text/x-patch, Size: 5886 bytes --]
From 8438bc036bb60622c5c2e03582ba2cf471baf998 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= <mattiase@acm.org>
Date: Fri, 17 May 2019 11:25:06 +0200
Subject: [PATCH] Correctly eliminate duplicate cases in switch compilation
Fix code mistakes that prevented the correct elimination of duplicated
cases when compiling a `cond' form to a switch bytecode, as in
(cond ((eq x 'a) 1)
((eq x 'b) 2)
((eq x 'a) 3) ; should be elided
((eq x 'c) 4))
Sometimes, this caused the bytecode to use the wrong branch (bug#35770).
* lisp/emacs-lisp/bytecomp.el (byte-compile-cond-vars): Return obj2 eval'ed.
(byte-compile-cond-jump-table-info):
Discard redundant condition. Use `obj2' as evaluated.
Discard duplicated cases instead of failing the table generation.
* test/lisp/emacs-lisp/bytecomp-tests.el (toplevel): Require subr-x.
(byte-opt-testsuite-arith-data, bytecomp-test--switch-duplicates): Test.
---
lisp/emacs-lisp/bytecomp.el | 13 +++---
test/lisp/emacs-lisp/bytecomp-tests.el | 55 +++++++++++++++++++++++++-
2 files changed, 60 insertions(+), 8 deletions(-)
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index e76baf5ed0..ce348ed313 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -4091,8 +4091,8 @@ byte-compile-cond-vars
;; and the other is a constant expression whose value can be
;; compared with `eq' (with `macroexp-const-p').
(or
- (and (symbolp obj1) (macroexp-const-p obj2) (cons obj1 obj2))
- (and (symbolp obj2) (macroexp-const-p obj1) (cons obj2 obj1))))
+ (and (symbolp obj1) (macroexp-const-p obj2) (cons obj1 (eval obj2)))
+ (and (symbolp obj2) (macroexp-const-p obj1) (cons obj2 (eval obj1)))))
(defconst byte-compile--default-val (cons nil nil) "A unique object.")
@@ -4121,12 +4121,11 @@ byte-compile-cond-jump-table-info
(unless prev-test
(setq prev-test test))
(if (and obj1 (memq test '(eq eql equal))
- (consp condition)
(eq test prev-test)
- (eq obj1 prev-var)
- ;; discard duplicate clauses
- (not (assq obj2 cases)))
- (push (list (if (consp obj2) (eval obj2) obj2) body) cases)
+ (eq obj1 prev-var))
+ ;; discard duplicate clauses
+ (unless (assoc obj2 cases test)
+ (push (list obj2 body) cases))
(if (and (macroexp-const-p condition) condition)
(progn (push (list byte-compile--default-val
(or body `(,condition)))
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index 5fb64ff288..0c5f8e7250 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -27,6 +27,7 @@
(require 'ert)
(require 'cl-lib)
+(require 'subr-x)
(require 'bytecomp)
;;; Code:
@@ -296,7 +297,21 @@ byte-opt-testsuite-arith-data
((eq variable 'default)
(message "equal"))
(t
- (message "not equal")))))
+ (message "not equal"))))
+ ;; Bug#35770
+ (let ((x 'a)) (cond ((eq x 'a) 'correct)
+ ((eq x 'b) 'incorrect)
+ ((eq x 'a) 'incorrect)
+ ((eq x 'c) 'incorrect)))
+ (let ((x #x10000000000000000))
+ (cond ((eql x #x10000000000000000) 'correct)
+ ((eql x #x10000000000000001) 'incorrect)
+ ((eql x #x10000000000000000) 'incorrect)
+ ((eql x #x10000000000000002) 'incorrect)))
+ (let ((x "a")) (cond ((equal x "a") 'correct)
+ ((equal x "b") 'incorrect)
+ ((equal x "a") 'incorrect)
+ ((equal x "c") 'incorrect))))
"List of expression for test.
Each element will be executed by interpreter and with
bytecompiled code, and their results compared.")
@@ -613,6 +628,44 @@ bytecomp-tests--with-temp-file
(if (buffer-live-p byte-compile-log-buffer)
(kill-buffer byte-compile-log-buffer)))))
+(ert-deftest bytecomp-test--switch-duplicates ()
+ "Check that duplicates in switches are eliminated correctly (bug#35770)."
+ (dolist (params
+ '(((lambda (x)
+ (cond ((eq x 'a) 111)
+ ((eq x 'b) 222)
+ ((eq x 'a) 333)
+ ((eq x 'c) 444)))
+ (a b c)
+ (lambda (u v) (string< (symbol-name u) (symbol-name v))))
+ ((lambda (x)
+ (cond ((eql x #x10000000000000000) 111)
+ ((eql x #x10000000000000001) 222)
+ ((eql x #x10000000000000000) 333)
+ ((eql x #x10000000000000002) 444)))
+ (#x10000000000000000 #x10000000000000001 #x10000000000000002)
+ <)
+ ((lambda (x)
+ (cond ((equal x "a") 111)
+ ((equal x "b") 222)
+ ((equal x "a") 333)
+ ((equal x "c") 444)))
+ ("a" "b" "c")
+ string<)))
+ (let* ((lisp (nth 0 params))
+ (keys (nth 1 params))
+ (lessp (nth 2 params))
+ (bc (byte-compile lisp))
+ (lap (byte-decompile-bytecode (aref bc 1) (aref bc 2)))
+ ;; Assume the first constant is the switch table.
+ (table (cadr (assq 'byte-constant lap))))
+ (should (hash-table-p table))
+ (should (equal (sort (hash-table-keys table) lessp) keys))
+ (should (member '(byte-constant 111) lap))
+ (should (member '(byte-constant 222) lap))
+ (should-not (member '(byte-constant 333) lap))
+ (should (member '(byte-constant 444) lap)))))
+
;; Local Variables:
;; no-byte-compile: t
;; End:
--
2.20.1
next prev parent reply other threads:[~2019-05-17 14:48 UTC|newest]
Thread overview: 16+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-05-17 9:33 bug#35770: [PATCH] Broken duplicate case elimination in switch byte-compilation Mattias Engdegård
2019-05-17 12:16 ` Stefan Monnier
2019-05-17 14:48 ` Mattias Engdegård [this message]
2019-05-22 10:52 ` Mattias Engdegård
2019-05-22 10:58 ` Eli Zaretskii
2019-05-22 11:11 ` Mattias Engdegård
2019-05-22 11:21 ` Noam Postavsky
2019-05-22 11:23 ` Eli Zaretskii
2019-05-22 14:19 ` Stefan Monnier
2019-05-26 17:05 ` Mattias Engdegård
2019-05-26 18:43 ` Eli Zaretskii
2019-05-26 22:06 ` Stefan Monnier
2019-05-27 11:27 ` Mattias Engdegård
2019-06-01 13:58 ` Noam Postavsky
2019-06-01 15:47 ` Eli Zaretskii
2019-06-01 21:53 ` Noam Postavsky
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=752237291204505cd6b3fb98f667c2718fa6361f.camel@acm.org \
--to=mattiase@acm.org \
--cc=35770@debbugs.gnu.org \
--cc=monnier@iro.umontreal.ca \
--cc=vibhavp@gmail.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.