aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMattias EngdegÄrd2023-06-13 14:08:11 +0200
committerMattias EngdegÄrd2023-06-13 14:27:48 +0200
commitef1394fca0405bb3738f4f08c21c2d0ca8602d52 (patch)
treea89c64257f151d2d265e0c5dacdd434838fd21c2
parentba349aa32e98a53146794197c316f4765598ddbd (diff)
downloademacs-ef1394fca0405bb3738f4f08c21c2d0ca8602d52.tar.gz
emacs-ef1394fca0405bb3738f4f08c21c2d0ca8602d52.zip
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.
-rw-r--r--lisp/emacs-lisp/bytecomp.el80
-rw-r--r--lisp/emacs-lisp/macroexp.el28
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."
3505 (if (consp arg) "list" (type-of arg)) 3505 (if (consp arg) "list" (type-of arg))
3506 idx)))))) 3506 idx))))))
3507 3507
3508 (let ((funargs (function-get (car form) 'funarg-positions)))
3509 (dolist (funarg funargs)
3510 (let ((arg (if (numberp funarg)
3511 (nth funarg form)
3512 (cadr (memq funarg form)))))
3513 (when (and (eq 'quote (car-safe arg))
3514 (eq 'lambda (car-safe (cadr arg))))
3515 (byte-compile-warn-x
3516 arg "(lambda %s ...) quoted with %s rather than with #%s"
3517 (or (nth 1 (cadr arg)) "()")
3518 "'" "'"))))) ; avoid styled quotes
3519
3508 (if (eq (car-safe (symbol-function (car form))) 'macro) 3520 (if (eq (car-safe (symbol-function (car form))) 'macro)
3509 (byte-compile-report-error 3521 (byte-compile-report-error
3510 (format-message "`%s' defined after use in %S (missing `require' of a library file?)" 3522 (format-message "`%s' defined after use in %S (missing `require' of a library file?)"
@@ -3614,6 +3626,74 @@ lambda-expression."
3614 (dolist (entry mutating-fns) 3626 (dolist (entry mutating-fns)
3615 (put (car entry) 'mutates-arguments (cdr entry)))) 3627 (put (car entry) 'mutates-arguments (cdr entry))))
3616 3628
3629;; Record which arguments expect functions, so we can warn when those
3630;; are accidentally quoted with ' rather than with #'
3631;; The value of the `funarg-positions' property is a list of function
3632;; argument positions, starting with 1, and keywords.
3633(dolist (f '( funcall apply mapcar mapatoms mapconcat mapc maphash
3634 mapcan map-char-table map-keymap map-keymap-internal
3635 functionp
3636 seq-do seq-do-indexed seq-sort seq-sort-by seq-group-by
3637 seq-find seq-count
3638 seq-filter seq-reduce seq-remove seq-keep
3639 seq-map seq-map-indexed seq-mapn seq-mapcat
3640 seq-drop-while seq-take-while
3641 seq-some seq-every-p
3642 cl-every cl-some
3643 cl-mapcar cl-mapcan cl-mapcon cl-mapc cl-mapl cl-maplist
3644 ))
3645 (put f 'funarg-positions '(1)))
3646(dolist (f '( defalias fset sort
3647 replace-regexp-in-string
3648 add-hook remove-hook advice-remove advice--remove-function
3649 global-set-key local-set-key keymap-global-set keymap-local-set
3650 set-process-filter set-process-sentinel
3651 ))
3652 (put f 'funarg-positions '(2)))
3653(dolist (f '( assoc assoc-default assoc-delete-all
3654 plist-get plist-member
3655 advice-add define-key keymap-set
3656 run-at-time run-with-idle-timer run-with-timer
3657 seq-contains seq-contains-p seq-set-equal-p
3658 seq-position seq-positions seq-uniq
3659 seq-union seq-intersection seq-difference))
3660 (put f 'funarg-positions '(3)))
3661(dolist (f '( cl-find cl-member cl-assoc cl-rassoc cl-position cl-count
3662 cl-remove cl-delete
3663 cl-subst cl-nsubst
3664 cl-substitute cl-nsubstitute
3665 cl-remove-duplicates cl-delete-duplicates
3666 cl-union cl-nunion cl-intersection cl-nintersection
3667 cl-set-difference cl-nset-difference
3668 cl-set-exclusive-or cl-nset-exclusive-or
3669 cl-nsublis
3670 cl-search
3671 ))
3672 (put f 'funarg-positions '(:test :test-not :key)))
3673(dolist (f '( cl-find-if cl-find-if-not cl-member-if cl-member-if-not
3674 cl-assoc-if cl-assoc-if-not cl-rassoc-if cl-rassoc-if-not
3675 cl-position-if cl-position-if-not cl-count-if cl-count-if-not
3676 cl-remove-if cl-remove-if-not cl-delete-if cl-delete-if-not
3677 cl-reduce cl-adjoin
3678 cl-subsetp
3679 ))
3680 (put f 'funarg-positions '(1 :key)))
3681(dolist (f '( cl-subst-if cl-subst-if-not cl-nsubst-if cl-nsubst-if-not
3682 cl-substitute-if cl-substitute-if-not
3683 cl-nsubstitute-if cl-nsubstitute-if-not
3684 cl-sort cl-stable-sort
3685 ))
3686 (put f 'funarg-positions '(2 :key)))
3687(dolist (fa '((plist-put 4) (alist-get 5) (add-to-list 5)
3688 (cl-merge 4 :key)
3689 (custom-declare-variable :set :get :initialize :safe)
3690 (make-process :filter :sentinel)
3691 (make-network-process :filter :sentinel)
3692 (all-completions 2 3) (try-completion 2 3) (test-completion 2 3)
3693 (completing-read 2 3)
3694 ))
3695 (put (car fa) 'funarg-positions (cdr fa)))
3696
3617 3697
3618(defun byte-compile-normal-call (form) 3698(defun byte-compile-normal-call (form)
3619 (when (and (symbolp (car form)) 3699 (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'."
461 (_ `(,fn ,eexp . ,eargs))))) 461 (_ `(,fn ,eexp . ,eargs)))))
462 (`(funcall . ,_) form) ;bug#53227 462 (`(funcall . ,_) form) ;bug#53227
463 (`(,func . ,_) 463 (`(,func . ,_)
464 (let ((handler (function-get func 'compiler-macro)) 464 (let ((handler (function-get func 'compiler-macro)))
465 (funargs (function-get func 'funarg-positions)))
466 ;; Check functions quoted with ' rather than with #'
467 (dolist (funarg funargs)
468 (let ((arg (nth funarg form)))
469 (when (and (eq 'quote (car-safe arg))
470 (eq 'lambda (car-safe (cadr arg))))
471 (setcar
472 (nthcdr funarg form)
473 (macroexp-warn-and-return
474 (format
475 "(lambda %s ...) quoted with ' rather than with #'"
476 (or (nth 1 (cadr arg)) "()"))
477 arg nil nil (cadr arg))))))
478 ;; Macro expand compiler macros. This cannot be delayed to 465 ;; Macro expand compiler macros. This cannot be delayed to
479 ;; byte-optimize-form because the output of the compiler-macro can 466 ;; byte-optimize-form because the output of the compiler-macro can
480 ;; use macros. 467 ;; use macros.
@@ -501,19 +488,6 @@ Assumes the caller has bound `macroexpand-all-environment'."
501 (_ form)))) 488 (_ form))))
502 (pop byte-compile-form-stack))) 489 (pop byte-compile-form-stack)))
503 490
504;; Record which arguments expect functions, so we can warn when those
505;; are accidentally quoted with ' rather than with #'
506(dolist (f '( funcall apply mapcar mapatoms mapconcat mapc cl-mapcar maphash
507 mapcan map-char-table map-keymap map-keymap-internal))
508 (put f 'funarg-positions '(1)))
509(dolist (f '( add-hook remove-hook advice-remove advice--remove-function
510 defalias fset global-set-key run-after-idle-timeout
511 set-process-filter set-process-sentinel sort))
512 (put f 'funarg-positions '(2)))
513(dolist (f '( advice-add define-key
514 run-at-time run-with-idle-timer run-with-timer ))
515 (put f 'funarg-positions '(3)))
516
517;;;###autoload 491;;;###autoload
518(defun macroexpand-all (form &optional environment) 492(defun macroexpand-all (form &optional environment)
519 "Return result of expanding macros at all levels in FORM. 493 "Return result of expanding macros at all levels in FORM.