diff options
| author | Mattias EngdegÄrd | 2023-06-13 14:08:11 +0200 |
|---|---|---|
| committer | Mattias EngdegÄrd | 2023-06-13 14:27:48 +0200 |
| commit | ef1394fca0405bb3738f4f08c21c2d0ca8602d52 (patch) | |
| tree | a89c64257f151d2d265e0c5dacdd434838fd21c2 | |
| parent | ba349aa32e98a53146794197c316f4765598ddbd (diff) | |
| download | emacs-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.el | 80 | ||||
| -rw-r--r-- | 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." | |||
| 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. |