[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 9af399f: Fix byte compilation of (eq foo 'default)
From: |
Paul Eggert |
Subject: |
[Emacs-diffs] master 9af399f: Fix byte compilation of (eq foo 'default) |
Date: |
Sat, 16 Jun 2018 10:48:56 -0400 (EDT) |
branch: master
commit 9af399fd803ac1ca79f319945b9745b5b96122e7
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>
Fix byte compilation of (eq foo 'default)
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 @@ 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).
@@ -4124,7 +4126,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))))))
@@ -4139,11 +4143,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:
@@ -4175,9 +4180,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 7c5aa9a..ba62549 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -289,7 +289,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.")
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master 9af399f: Fix byte compilation of (eq foo 'default),
Paul Eggert <=