Warn about comparing quoted lists (etc) using `eq`

["Mattias Engdegård" <mattias.engdegard@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 989 bytes --]

I'm about to push a new byte-compiler warning that finds mistakes like

  (eq x '(ho hum))

Ie, attempts to compare, by identity, literals that may not match anything at all: quoted lists, strings, floats etc.

The warning finds about 20 such mistakes in the Emacs tree, including two by this programmer. So far no false positives have turned up, although not all warnings indicate actual bugs (many things just happen to work by luck). Typically the remedy is to use equal instead of eq, and so on.

The warning applies to arguments in calls to eq, eql, memq, memql, assq, rassq, remq and delq.

Given its usefulness and low risk (it does not actually change the behaviour of anything) I suggest it be added to the emacs-29 branch. Objections? (Clearly we'd like to fix the mistakes found in emacs-29, and doing so is a lot more convenient if the warning is actually there too.)

Patch below for reference. I don't think it merits a NEWS entry but could certainly add one.


[-- Attachment #2: 0001-Warn-about-unmatchable-constant-args-to-eq-memq-etc.patch --]
[-- Type: application/octet-stream, Size: 9015 bytes --]

From 65a701d7c9ecbdd810f94a18786f73e81e31f391 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= <mattiase@acm.org>
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 1babf3ec2c..b5e887db83 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -653,7 +653,8 @@ with-suppressed-warnings
 `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 f176e769bf..9af32102c0 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -5487,6 +5487,80 @@ batch-byte-recompile-directory
            (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 e7c308213e..00361a4286 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -837,9 +837,11 @@ bytecomp--with-warning-test
   (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 @@ bytecomp-warn-wide-docstring/defvar
   (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.32.0 (Apple Git-132)