master 730a39e881 2/3: Warn about lambda expressions in comparisons

[Mattias Engdegård]

branch: master
commit 730a39e8810e91ad3bb70af191229b78c3858983
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    Warn about lambda expressions in comparisons
    
    Lambda expressions are not comparable; warn about calls such as
    (eq x (lambda ...)) etc.
    
    * lisp/emacs-lisp/bytecomp.el (bytecomp--dodgy-eq-arg): Rename to...
    (bytecomp--dodgy-eq-arg-p): ...this.  Use pcase.  Add lambda checks.
    (bytecomp--value-type-description, bytecomp--arg-type-description)
    (bytecomp--check-eq-args, bytecomp--check-memq-args): Add function
    checks.  Update calls.  Make compiler-macro arguments optional to
    avoid crashes in malformed code.
    * test/lisp/emacs-lisp/bytecomp-tests.el
    (bytecomp--with-warning-test): Simplify argument.  Run each
    compilation with a fresh (empty) warning cache.  Add ert-info for
    easier debugging.
    (bytecomp-warn-dodgy-args-eq, bytecomp-warn-dodgy-args-memq):
    Add lambda tests.
---
 lisp/emacs-lisp/bytecomp.el            | 39 ++++++++++++++++++----------------
 test/lisp/emacs-lisp/bytecomp-tests.el | 20 +++++++++++------
 2 files changed, 35 insertions(+), 24 deletions(-)

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 9af32102c0..7571b4d409 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -5489,24 +5489,27 @@ and corresponding effects."
 
 ;; Check for (in)comparable constant values in calls to `eq', `memq' etc.
 
-(defun bytecomp--dodgy-eq-arg (x number-ok)
+(defun bytecomp--dodgy-eq-arg-p (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)))
+  (pcase x
+    ((or `(quote ,(pred consp)) `(function (lambda . ,_))) t)
+    ((or (pred consp) (pred symbolp)) nil)
+    ((pred integerp)
+     (not (or (<= -536870912 x 536870911) number-ok)))
+    ((pred floatp) (not number-ok))
+    (_ t)))
 
 (defun bytecomp--value-type-description (x)
-  (cond ((and x (proper-list-p x)) "list")
-        ((recordp x) "record")
-        (t (symbol-name (type-of x)))))
+  (cond
+    ((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)))
+  (pcase x
+    (`(function (lambda . ,_)) "function")
+    (`(quote . ,val) (bytecomp--value-type-description val))
+    (_ (bytecomp--value-type-description x))))
 
 (defun bytecomp--warn-dodgy-eq-arg (form type parenthesis)
   (macroexp-warn-and-return
@@ -5514,10 +5517,10 @@ and corresponding effects."
            (car form) type parenthesis)
    form '(suspicious eq) t))
 
-(defun bytecomp--check-eq-args (form a b &rest _ignore)
+(defun bytecomp--check-eq-args (form &optional 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))))
+         (bad-arg (cond ((bytecomp--dodgy-eq-arg-p a number-ok) 1)
+                        ((bytecomp--dodgy-eq-arg-p b number-ok) 2))))
     (if bad-arg
         (bytecomp--warn-dodgy-eq-arg
          form
@@ -5528,11 +5531,11 @@ and corresponding effects."
 (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)
+(defun bytecomp--check-memq-args (form &optional elem list &rest _ignore)
   (let* ((fn (car form))
          (number-ok (eq fn 'memql)))
     (cond
-     ((bytecomp--dodgy-eq-arg elem number-ok)
+     ((bytecomp--dodgy-eq-arg-p elem number-ok)
       (bytecomp--warn-dodgy-eq-arg
        form (bytecomp--arg-type-description elem) "arg 1"))
      ((and (consp list) (eq (car list) 'quote)
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el 
b/test/lisp/emacs-lisp/bytecomp-tests.el
index 00361a4286..3400128759 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -833,15 +833,19 @@ byte-compiled.  Run with dynamic binding."
     ;; Should not warn that mt--test2 is not known to be defined.
     (should-not (re-search-forward "my--test2" nil t))))
 
-(defmacro bytecomp--with-warning-test (re-warning &rest form)
+(defmacro bytecomp--with-warning-test (re-warning form)
   (declare (indent 1))
   `(with-current-buffer (get-buffer-create "*Compile-Log*")
      (let ((inhibit-read-only t)) (erase-buffer))
-     (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)))))))
+     (let ((text-quoting-style 'grave)
+           (macroexp--warned
+            (make-hash-table :test #'equal :weakness 'key))   ; oh dear
+           (form ,form))
+       (ert-info ((prin1-to-string form) :prefix "form: ")
+         (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"
@@ -874,6 +878,8 @@ byte-compiled.  Run with dynamic binding."
       (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]))
+      (bytecomp--with-warning-test (msg "function" 2) `(,fn 'x (lambda () 1)))
+      (bytecomp--with-warning-test (msg "function" 2) `(,fn 'x #'(lambda () 
1)))
       (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))))))
@@ -899,6 +905,8 @@ byte-compiled.  Run with dynamic binding."
     (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)))
+    (bytecomp--with-warning-test (msg1 "function") `(,fn (lambda () 1) '(x)))
+    (bytecomp--with-warning-test (msg1 "function") `(,fn #'(lambda () 1) '(x)))
     (unless (eq fn 'memql)
       (bytecomp--with-warning-test (msg1 "integer") `(,fn #x10000000000 '(x)))
       (bytecomp--with-warning-test (msg1 "float")   `(,fn 1.0 '(x))))