diff options
Diffstat (limited to 'lisp/emacs-lisp')
| -rw-r--r-- | lisp/emacs-lisp/byte-run.el | 3 | ||||
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 74 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 3 | ||||
| -rw-r--r-- | lisp/emacs-lisp/easy-mmode.el | 7 |
4 files changed, 82 insertions, 5 deletions
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 1babf3ec2c4..b5e887db836 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -653,7 +653,8 @@ types. The types that can be suppressed with this macro are `suspicious'. For the `mapcar' case, only the `mapcar' function can be used in -the symbol list. For `suspicious', only `set-buffer' and `lsh' can be used." +the symbol list. For `suspicious', only `set-buffer', `lsh' and `eq' +can be used." ;; Note: during compilation, this definition is overridden by the one in ;; byte-compile-initial-macro-environment. (declare (debug (sexp body)) (indent 1)) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index f176e769bf5..9af32102c06 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -5487,6 +5487,80 @@ and corresponding effects." (eval form) form))) +;; Check for (in)comparable constant values in calls to `eq', `memq' etc. + +(defun bytecomp--dodgy-eq-arg (x number-ok) + "Whether X is a bad argument to `eq' (or `eql' if NUMBER-OK is non-nil)." + (cond ((consp x) (and (eq (car x) 'quote) (consp (cadr x)))) + ((symbolp x) nil) + ((integerp x) (not (or (<= -536870912 x 536870911) number-ok))) + ((floatp x) (not number-ok)) + (t t))) + +(defun bytecomp--value-type-description (x) + (cond ((and x (proper-list-p x)) "list") + ((recordp x) "record") + (t (symbol-name (type-of x))))) + +(defun bytecomp--arg-type-description (x) + (bytecomp--value-type-description + (if (and (consp x) (eq (car x) 'quote)) + (cadr x) + x))) + +(defun bytecomp--warn-dodgy-eq-arg (form type parenthesis) + (macroexp-warn-and-return + (format "`%s' called with literal %s that may never match (%s)" + (car form) type parenthesis) + form '(suspicious eq) t)) + +(defun bytecomp--check-eq-args (form a b &rest _ignore) + (let* ((number-ok (eq (car form) 'eql)) + (bad-arg (cond ((bytecomp--dodgy-eq-arg a number-ok) 1) + ((bytecomp--dodgy-eq-arg b number-ok) 2)))) + (if bad-arg + (bytecomp--warn-dodgy-eq-arg + form + (bytecomp--arg-type-description (nth bad-arg form)) + (format "arg %d" bad-arg)) + form))) + +(put 'eq 'compiler-macro #'bytecomp--check-eq-args) +(put 'eql 'compiler-macro #'bytecomp--check-eq-args) + +(defun bytecomp--check-memq-args (form elem list &rest _ignore) + (let* ((fn (car form)) + (number-ok (eq fn 'memql))) + (cond + ((bytecomp--dodgy-eq-arg elem number-ok) + (bytecomp--warn-dodgy-eq-arg + form (bytecomp--arg-type-description elem) "arg 1")) + ((and (consp list) (eq (car list) 'quote) + (proper-list-p (cadr list))) + (named-let loop ((elts (cadr list)) (i 1)) + (if elts + (let* ((elt (car elts)) + (x (cond ((eq fn 'assq) (car-safe elt)) + ((eq fn 'rassq) (cdr-safe elt)) + (t elt)))) + (if (or (symbolp x) + (and (integerp x) + (or (<= -536870912 x 536870911) number-ok)) + (and (floatp x) number-ok)) + (loop (cdr elts) (1+ i)) + (bytecomp--warn-dodgy-eq-arg + form (bytecomp--value-type-description x) + (format "element %d of arg 2" i)))) + form))) + (t form)))) + +(put 'memq 'compiler-macro #'bytecomp--check-memq-args) +(put 'memql 'compiler-macro #'bytecomp--check-memq-args) +(put 'assq 'compiler-macro #'bytecomp--check-memq-args) +(put 'rassq 'compiler-macro #'bytecomp--check-memq-args) +(put 'remq 'compiler-macro #'bytecomp--check-memq-args) +(put 'delq 'compiler-macro #'bytecomp--check-memq-args) + (provide 'byte-compile) (provide 'bytecomp) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 43a2ed92059..95e78ceab6a 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2052,7 +2052,8 @@ info node `(cl) Function Bindings' for details. (dolist (binding bindings) (let ((var (make-symbol (format "--cl-%s--" (car binding)))) (args-and-body (cdr binding))) - (if (and (= (length args-and-body) 1) (symbolp (car args-and-body))) + (if (and (= (length args-and-body) 1) + (macroexp-copyable-p (car args-and-body))) ;; Optimize (cl-flet ((fun var)) body). (setq var (car args-and-body)) (push (list var (if (= (length args-and-body) 1) diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 2df390ecbeb..7d54a84687b 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -417,6 +417,8 @@ No problems result if this variable is not bound. `(defvar ,keymap-sym (let ((m ,keymap)) (cond ((keymapp m) m) + ;; FIXME: `easy-mmode-define-keymap' is obsolete, + ;; so this form should also be obsolete somehow. ((listp m) (with-suppressed-warnings ((obsolete easy-mmode-define-keymap)) @@ -682,6 +684,7 @@ Valid keywords and arguments are: :group Ignored. :suppress Non-nil to call `suppress-keymap' on keymap, `nodigits' to suppress digits as prefix arguments." + (declare (obsolete define-keymap "29.1")) (let (inherit dense suppress) (while args (let ((key (pop args)) @@ -722,9 +725,7 @@ The M, BS, and ARGS arguments are as per that function. DOC is the constant's documentation. This macro is deprecated; use `defvar-keymap' instead." - ;; FIXME: Declare obsolete in favor of `defvar-keymap'. It is still - ;; used for `gud-menu-map' and `gud-minor-mode-map', so fix that first. - (declare (doc-string 3) (indent 1)) + (declare (doc-string 3) (indent 1) (obsolete defvar-keymap "29.1")) `(defconst ,m (easy-mmode-define-keymap ,bs nil (if (boundp ',m) ,m) ,(cons 'list args)) ,doc)) |