From 537f78b537ddd56198059bc02b5abc6e51c5b523 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Mattias=20Engdeg=C3=A5rd?= Date: Wed, 14 Dec 2022 17:48:17 +0100 Subject: [PATCH] Warn about unmatchable constant args to `eq`, `memq` etc Add a byte-compiler warning about attempts to compare literal values with undefined identity relation to other values. For example: (eq x 2.0) (memq x '("a" (b) [c])) Such incomparable values include all literal conses, strings, vectors, records and (except for eql and memql) floats and bignums. The warning currently applies to eq, eql, memq, memql, assq, rassq, remq and delq. * lisp/emacs-lisp/bytecomp.el (bytecomp--dodgy-eq-arg) (bytecomp--value-type-description, bytecomp--arg-type-description) (bytecomp--warn-dodgy-eq-arg, bytecomp--check-eq-args) (bytecomp--check-memq-args): New. (eq, eql, memq, memql, assq, rassq, remq, delq): Set compiler-macro property. * lisp/emacs-lisp/byte-run.el (with-suppressed-warnings): Amend doc string. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp--with-warning-test): Fix text-quoting-style and expand re-warning so that it doesn't need to be a literal. (bytecomp-warn-dodgy-args-eq, bytecomp-warn-dodgy-args-memq): New tests. --- lisp/emacs-lisp/byte-run.el | 3 +- lisp/emacs-lisp/bytecomp.el | 74 ++++++++++++++++++++++++++ test/lisp/emacs-lisp/bytecomp-tests.el | 54 +++++++++++++++++-- 3 files changed, 127 insertions(+), 4 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/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index e7c308213e4..00361a4286b 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -837,9 +837,11 @@ byte-compiled. Run with dynamic binding." (declare (indent 1)) `(with-current-buffer (get-buffer-create "*Compile-Log*") (let ((inhibit-read-only t)) (erase-buffer)) - (byte-compile ,@form) - (ert-info ((prin1-to-string (buffer-string)) :prefix "buffer: ") - (should (re-search-forward ,(string-replace " " "[ \n]+" re-warning)))))) + (let ((text-quoting-style 'grave)) + (byte-compile ,@form) + (ert-info ((prin1-to-string (buffer-string)) :prefix "buffer: ") + (should (re-search-forward + (string-replace " " "[ \n]+" ,re-warning))))))) (ert-deftest bytecomp-warn-wrong-args () (bytecomp--with-warning-test "remq.*3.*2" @@ -863,6 +865,52 @@ byte-compiled. Run with dynamic binding." (bytecomp--with-warning-test "defvar.*foo.*wider than.*characters" `(defvar foo t ,bytecomp-tests--docstring))) +(ert-deftest bytecomp-warn-dodgy-args-eq () + (dolist (fn '(eq eql)) + (cl-flet ((msg (type arg) + (format + "`%s' called with literal %s that may never match (arg %d)" + fn type arg))) + (bytecomp--with-warning-test (msg "list" 1) `(,fn '(a) 'x)) + (bytecomp--with-warning-test (msg "string" 2) `(,fn 'x "a")) + (bytecomp--with-warning-test (msg "vector" 2) `(,fn 'x [a])) + (unless (eq fn 'eql) + (bytecomp--with-warning-test (msg "integer" 2) `(,fn 'x #x10000000000)) + (bytecomp--with-warning-test (msg "float" 2) `(,fn 'x 1.0)))))) + +(ert-deftest bytecomp-warn-dodgy-args-memq () + (dolist (fn '(memq memql remq delq assq rassq)) + (cl-labels + ((msg1 (type) + (format + "`%s' called with literal %s that may never match (arg 1)" + fn type)) + (msg2 (type) + (format + "`%s' called with literal %s that may never match (element 2 of arg 2)" + fn type)) + (lst (elt) + (cond ((eq fn 'assq) `((a . 1) (,elt . 2) (c . 3))) + ((eq fn 'rassq) `((1 . a) (2 . ,elt) (3 . c))) + (t `(a ,elt c)))) + (form2 (elt) + `(,fn 'x ',(lst elt)))) + + (bytecomp--with-warning-test (msg1 "list") `(,fn '(a) '(x))) + (bytecomp--with-warning-test (msg1 "string") `(,fn "a" '(x))) + (bytecomp--with-warning-test (msg1 "vector") `(,fn [a] '(x))) + (unless (eq fn 'memql) + (bytecomp--with-warning-test (msg1 "integer") `(,fn #x10000000000 '(x))) + (bytecomp--with-warning-test (msg1 "float") `(,fn 1.0 '(x)))) + + (bytecomp--with-warning-test (msg2 "list") (form2 '(b))) + (bytecomp--with-warning-test (msg2 "list") (form2 ''b)) + (bytecomp--with-warning-test (msg2 "string") (form2 "b")) + (bytecomp--with-warning-test (msg2 "vector") (form2 [b])) + (unless (eq fn 'memql) + (bytecomp--with-warning-test (msg2 "integer") (form2 #x10000000000)) + (bytecomp--with-warning-test (msg2 "float") (form2 1.0)))))) + (defmacro bytecomp--define-warning-file-test (file re-warning &optional reverse) `(ert-deftest ,(intern (format "bytecomp/%s" file)) () (with-current-buffer (get-buffer-create "*Compile-Log*") -- 2.39.2