From 730a39e8810e91ad3bb70af191229b78c3858983 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sat, 17 Dec 2022 14:48:34 +0100 Subject: [PATCH] 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 9af32102c06..7571b4d409a 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 00361a4286b..3400128759a 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)))) -- 2.39.2