From ef1394fca0405bb3738f4f08c21c2d0ca8602d52 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Mattias=20Engdeg=C3=A5rd?= Date: Tue, 13 Jun 2023 14:08:11 +0200 Subject: [PATCH] Move quoted lambda funarg check and expand coverage * lisp/emacs-lisp/macroexp.el (macroexp--expand-all): Move check for incorrectly quoted lambda arguments from here... * lisp/emacs-lisp/bytecomp.el (byte-compile-form): ... to here, which should provide more detection opportunities. Expand the set of functions for which this check is performed, now also for some keyword arguments. --- lisp/emacs-lisp/bytecomp.el | 80 +++++++++++++++++++++++++++++++++++++ lisp/emacs-lisp/macroexp.el | 28 +------------ 2 files changed, 81 insertions(+), 27 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 4cf244aedbf..0d878846304 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3505,6 +3505,18 @@ lambda-expression." (if (consp arg) "list" (type-of arg)) idx)))))) + (let ((funargs (function-get (car form) 'funarg-positions))) + (dolist (funarg funargs) + (let ((arg (if (numberp funarg) + (nth funarg form) + (cadr (memq funarg form))))) + (when (and (eq 'quote (car-safe arg)) + (eq 'lambda (car-safe (cadr arg)))) + (byte-compile-warn-x + arg "(lambda %s ...) quoted with %s rather than with #%s" + (or (nth 1 (cadr arg)) "()") + "'" "'"))))) ; avoid styled quotes + (if (eq (car-safe (symbol-function (car form))) 'macro) (byte-compile-report-error (format-message "`%s' defined after use in %S (missing `require' of a library file?)" @@ -3614,6 +3626,74 @@ lambda-expression." (dolist (entry mutating-fns) (put (car entry) 'mutates-arguments (cdr entry)))) +;; Record which arguments expect functions, so we can warn when those +;; are accidentally quoted with ' rather than with #' +;; The value of the `funarg-positions' property is a list of function +;; argument positions, starting with 1, and keywords. +(dolist (f '( funcall apply mapcar mapatoms mapconcat mapc maphash + mapcan map-char-table map-keymap map-keymap-internal + functionp + seq-do seq-do-indexed seq-sort seq-sort-by seq-group-by + seq-find seq-count + seq-filter seq-reduce seq-remove seq-keep + seq-map seq-map-indexed seq-mapn seq-mapcat + seq-drop-while seq-take-while + seq-some seq-every-p + cl-every cl-some + cl-mapcar cl-mapcan cl-mapcon cl-mapc cl-mapl cl-maplist + )) + (put f 'funarg-positions '(1))) +(dolist (f '( defalias fset sort + replace-regexp-in-string + add-hook remove-hook advice-remove advice--remove-function + global-set-key local-set-key keymap-global-set keymap-local-set + set-process-filter set-process-sentinel + )) + (put f 'funarg-positions '(2))) +(dolist (f '( assoc assoc-default assoc-delete-all + plist-get plist-member + advice-add define-key keymap-set + run-at-time run-with-idle-timer run-with-timer + seq-contains seq-contains-p seq-set-equal-p + seq-position seq-positions seq-uniq + seq-union seq-intersection seq-difference)) + (put f 'funarg-positions '(3))) +(dolist (f '( cl-find cl-member cl-assoc cl-rassoc cl-position cl-count + cl-remove cl-delete + cl-subst cl-nsubst + cl-substitute cl-nsubstitute + cl-remove-duplicates cl-delete-duplicates + cl-union cl-nunion cl-intersection cl-nintersection + cl-set-difference cl-nset-difference + cl-set-exclusive-or cl-nset-exclusive-or + cl-nsublis + cl-search + )) + (put f 'funarg-positions '(:test :test-not :key))) +(dolist (f '( cl-find-if cl-find-if-not cl-member-if cl-member-if-not + cl-assoc-if cl-assoc-if-not cl-rassoc-if cl-rassoc-if-not + cl-position-if cl-position-if-not cl-count-if cl-count-if-not + cl-remove-if cl-remove-if-not cl-delete-if cl-delete-if-not + cl-reduce cl-adjoin + cl-subsetp + )) + (put f 'funarg-positions '(1 :key))) +(dolist (f '( cl-subst-if cl-subst-if-not cl-nsubst-if cl-nsubst-if-not + cl-substitute-if cl-substitute-if-not + cl-nsubstitute-if cl-nsubstitute-if-not + cl-sort cl-stable-sort + )) + (put f 'funarg-positions '(2 :key))) +(dolist (fa '((plist-put 4) (alist-get 5) (add-to-list 5) + (cl-merge 4 :key) + (custom-declare-variable :set :get :initialize :safe) + (make-process :filter :sentinel) + (make-network-process :filter :sentinel) + (all-completions 2 3) (try-completion 2 3) (test-completion 2 3) + (completing-read 2 3) + )) + (put (car fa) 'funarg-positions (cdr fa))) + (defun byte-compile-normal-call (form) (when (and (symbolp (car form)) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 8a0185d597b..f3d0804323e 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -461,20 +461,7 @@ Assumes the caller has bound `macroexpand-all-environment'." (_ `(,fn ,eexp . ,eargs))))) (`(funcall . ,_) form) ;bug#53227 (`(,func . ,_) - (let ((handler (function-get func 'compiler-macro)) - (funargs (function-get func 'funarg-positions))) - ;; Check functions quoted with ' rather than with #' - (dolist (funarg funargs) - (let ((arg (nth funarg form))) - (when (and (eq 'quote (car-safe arg)) - (eq 'lambda (car-safe (cadr arg)))) - (setcar - (nthcdr funarg form) - (macroexp-warn-and-return - (format - "(lambda %s ...) quoted with ' rather than with #'" - (or (nth 1 (cadr arg)) "()")) - arg nil nil (cadr arg)))))) + (let ((handler (function-get func 'compiler-macro))) ;; Macro expand compiler macros. This cannot be delayed to ;; byte-optimize-form because the output of the compiler-macro can ;; use macros. @@ -501,19 +488,6 @@ Assumes the caller has bound `macroexpand-all-environment'." (_ form)))) (pop byte-compile-form-stack))) -;; Record which arguments expect functions, so we can warn when those -;; are accidentally quoted with ' rather than with #' -(dolist (f '( funcall apply mapcar mapatoms mapconcat mapc cl-mapcar maphash - mapcan map-char-table map-keymap map-keymap-internal)) - (put f 'funarg-positions '(1))) -(dolist (f '( add-hook remove-hook advice-remove advice--remove-function - defalias fset global-set-key run-after-idle-timeout - set-process-filter set-process-sentinel sort)) - (put f 'funarg-positions '(2))) -(dolist (f '( advice-add define-key - run-at-time run-with-idle-timer run-with-timer )) - (put f 'funarg-positions '(3))) - ;;;###autoload (defun macroexpand-all (form &optional environment) "Return result of expanding macros at all levels in FORM. -- 2.39.2