diff options
| -rw-r--r-- | doc/lispref/compile.texi | 26 | ||||
| -rw-r--r-- | etc/NEWS | 4 | ||||
| -rw-r--r-- | lisp/emacs-lisp/byte-run.el | 28 | ||||
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 82 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/bytecomp-tests.el | 90 |
5 files changed, 203 insertions, 27 deletions
diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi index d9db55e22cd..4ff0e1c91e4 100644 --- a/doc/lispref/compile.texi +++ b/doc/lispref/compile.texi @@ -505,8 +505,25 @@ current lexical scope, or file if at top-level.) @xref{Defining Variables}. @end itemize - You can also suppress any and all compiler warnings within a certain -expression using the construct @code{with-no-warnings}: + You can also suppress compiler warnings within a certain expression +using the @code{with-suppressed-warnings} macro: + +@defspec with-suppressed-warnings warnings body@dots{} +In execution, this is equivalent to @code{(progn @var{body}...)}, but +the compiler does not issue warnings for the specified conditions in +@var{body}. @var{warnings} is an associative list of warning symbols +and function/variable symbols they apply to. For instance, if you +wish to call an obsolete function called @code{foo}, but want to +suppress the compilation warning, say: + +@lisp +(with-suppressed-warnings ((obsolete foo)) + (foo ...)) +@end lisp +@end defspec + +For more coarse-grained suppression of compiler warnings, you can use +the @code{with-no-warnings} construct: @c This is implemented with a defun, but conceptually it is @c a special form. @@ -516,8 +533,9 @@ In execution, this is equivalent to @code{(progn @var{body}...)}, but the compiler does not issue warnings for anything that occurs inside @var{body}. -We recommend that you use this construct around the smallest -possible piece of code, to avoid missing possible warnings other than +We recommend that you use @code{with-suppressed-warnings} instead, but +if you do use this construct, that you use it around the smallest +possible piece of code to avoid missing possible warnings other than one you intend to suppress. @end defspec @@ -1693,6 +1693,10 @@ valid event type. * Lisp Changes in Emacs 27.1 +++ +** The new macro `with-suppressed-warnings' can be used to suppress +specific byte-compile warnings. + ++++ ** The 'append' arg of 'add-hook' is generalized to a finer notion of 'depth' This makes it possible to control the ordering of functions more precisely, as was already possible in 'add-function' and `advice-add`. diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 842d1d48b45..6a21a0c909d 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -494,6 +494,34 @@ is enabled." ;; The implementation for the interpreter is basically trivial. (car (last body))) +(defmacro with-suppressed-warnings (_warnings &rest body) + "Like `progn', but prevents compiler WARNINGS in BODY. + +WARNINGS is an associative list where the first element of each +item is a warning type, and the rest of the elements in each item +are symbols they apply to. For instance, if you want to suppress +byte compilation warnings about the two obsolete functions `foo' +and `bar', as well as the function `zot' being called with the +wrong number of parameters, say + +\(with-suppressed-warnings ((obsolete foo bar) + (callargs zot)) + (foo (bar)) + (zot 1 2)) + +The warnings that can be suppressed are a subset of the warnings +in `byte-compile-warning-types'; see this variable for a fuller +explanation of the warning types. The types that can be +suppressed with this macro are `free-vars', `callargs', +`redefine', `obsolete', `interactive-only', `lexical', `mapcar', +`constants' and `suspicious'. + +For the `mapcar' case, only the `mapcar' function can be used in +the symbol list. For `suspicious', only `set-buffer' can be used." + (declare (debug (sexp &optional body)) (indent 1)) + ;; The implementation for the interpreter is basically trivial. + `(progn ,@body)) + (defun byte-run--unescaped-character-literals-warning () "Return a warning about unescaped character literals. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index f2a38a9c6c3..13d563bde91 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -331,18 +331,27 @@ suppress. For example, (not mapcar) will suppress warnings about mapcar." ,@(mapcar (lambda (x) `(const ,x)) byte-compile-warning-types)))) +(defvar byte-compile--suppressed-warnings nil + "Dynamically bound by `with-suppressed-warnings' to suppress warnings.") + ;;;###autoload (put 'byte-compile-warnings 'safe-local-variable (lambda (v) (or (symbolp v) (null (delq nil (mapcar (lambda (x) (not (symbolp x))) v)))))) -(defun byte-compile-warning-enabled-p (warning) +(defun byte-compile-warning-enabled-p (warning &optional symbol) "Return non-nil if WARNING is enabled, according to `byte-compile-warnings'." - (or (eq byte-compile-warnings t) - (if (eq (car byte-compile-warnings) 'not) - (not (memq warning byte-compile-warnings)) - (memq warning byte-compile-warnings)))) + (let ((suppress nil)) + (dolist (elem byte-compile--suppressed-warnings) + (when (and (eq (car elem) warning) + (memq symbol (cdr elem))) + (setq suppress t))) + (and (not suppress) + (or (eq byte-compile-warnings t) + (if (eq (car byte-compile-warnings) 'not) + (not (memq warning byte-compile-warnings)) + (memq warning byte-compile-warnings)))))) ;;;###autoload (defun byte-compile-disable-warning (warning) @@ -502,7 +511,16 @@ Return the compile-time value of FORM." form macroexpand-all-environment))) (eval expanded lexical-binding) - expanded)))))) + expanded))))) + (with-suppressed-warnings + . ,(lambda (warnings &rest body) + ;; This function doesn't exist, but is just a placeholder + ;; symbol to hook up with the + ;; `byte-hunk-handler'/`byte-defop-compiler-1' machinery. + `(internal--with-suppressed-warnings + ',warnings + ,(macroexpand-all `(progn ,@body) + macroexpand-all-environment))))) "The default macro-environment passed to macroexpand by the compiler. Placing a macro here will cause a macro to have different semantics when expanded by the compiler as when expanded by the interpreter.") @@ -1268,7 +1286,7 @@ function directly; use `byte-compile-warn' or (defun byte-compile-warn-obsolete (symbol) "Warn that SYMBOL (a variable or function) is obsolete." - (when (byte-compile-warning-enabled-p 'obsolete) + (when (byte-compile-warning-enabled-p 'obsolete symbol) (let* ((funcp (get symbol 'byte-obsolete-info)) (msg (macroexp--obsolete-warning symbol @@ -2423,7 +2441,7 @@ list that represents a doc string reference. (defun byte-compile--declare-var (sym) (when (and (symbolp sym) (not (string-match "[-*/:$]" (symbol-name sym))) - (byte-compile-warning-enabled-p 'lexical)) + (byte-compile-warning-enabled-p 'lexical sym)) (byte-compile-warn "global/dynamic var `%s' lacks a prefix" sym)) (when (memq sym byte-compile-lexical-variables) @@ -2521,6 +2539,15 @@ list that represents a doc string reference. (mapc 'byte-compile-file-form (cdr form)) nil)) +(put 'internal--with-suppressed-warnings 'byte-hunk-handler + 'byte-compile-file-form-with-suppressed-warnings) +(defun byte-compile-file-form-with-suppressed-warnings (form) + ;; cf byte-compile-file-form-progn. + (let ((byte-compile--suppressed-warnings + (append (cadadr form) byte-compile--suppressed-warnings))) + (mapc 'byte-compile-file-form (cddr form)) + nil)) + ;; Automatically evaluate define-obsolete-function-alias etc at top-level. (put 'make-obsolete 'byte-hunk-handler 'byte-compile-file-form-make-obsolete) (defun byte-compile-file-form-make-obsolete (form) @@ -2559,7 +2586,7 @@ not to take responsibility for the actual compilation of the code." (setq byte-compile-call-tree (cons (list name nil nil) byte-compile-call-tree)))) - (if (byte-compile-warning-enabled-p 'redefine) + (if (byte-compile-warning-enabled-p 'redefine name) (byte-compile-arglist-warn name arglist macro)) (if byte-compile-verbose @@ -2571,7 +2598,7 @@ not to take responsibility for the actual compilation of the code." ;; This also silences "multiple definition" warnings for defmethods. nil) (that-one - (if (and (byte-compile-warning-enabled-p 'redefine) + (if (and (byte-compile-warning-enabled-p 'redefine name) ;; Don't warn when compiling the stubs in byte-run... (not (assq name byte-compile-initial-macro-environment))) (byte-compile-warn @@ -2579,7 +2606,7 @@ not to take responsibility for the actual compilation of the code." name)) (setcdr that-one nil)) (this-one - (when (and (byte-compile-warning-enabled-p 'redefine) + (when (and (byte-compile-warning-enabled-p 'redefine name) ;; Hack: Don't warn when compiling the magic internal ;; byte-compiler macros in byte-run.el... (not (assq name byte-compile-initial-macro-environment))) @@ -2588,7 +2615,7 @@ not to take responsibility for the actual compilation of the code." name))) ((eq (car-safe (symbol-function name)) (if macro 'lambda 'macro)) - (when (byte-compile-warning-enabled-p 'redefine) + (when (byte-compile-warning-enabled-p 'redefine name) (byte-compile-warn "%s `%s' being redefined as a %s" (if macro "function" "macro") name @@ -3153,7 +3180,7 @@ for symbols generated by the byte compiler itself." (when (and (byte-compile-warning-enabled-p 'suspicious) (macroexp--const-symbol-p fn)) (byte-compile-warn "`%s' called as a function" fn)) - (when (and (byte-compile-warning-enabled-p 'interactive-only) + (when (and (byte-compile-warning-enabled-p 'interactive-only fn) interactive-only) (byte-compile-warn "`%s' is for interactive use only%s" fn @@ -3194,8 +3221,8 @@ for symbols generated by the byte compiler itself." (byte-compile-discard)))) (defun byte-compile-normal-call (form) - (when (and (byte-compile-warning-enabled-p 'callargs) - (symbolp (car form))) + (when (and (symbolp (car form)) + (byte-compile-warning-enabled-p 'callargs (car form))) (if (memq (car form) '(custom-declare-group custom-declare-variable custom-declare-face)) @@ -3204,7 +3231,7 @@ for symbols generated by the byte compiler itself." (if byte-compile-generate-call-tree (byte-compile-annotate-call-tree form)) (when (and byte-compile--for-effect (eq (car form) 'mapcar) - (byte-compile-warning-enabled-p 'mapcar)) + (byte-compile-warning-enabled-p 'mapcar 'mapcar)) (byte-compile-set-symbol-position 'mapcar) (byte-compile-warn "`mapcar' called for effect; use `mapc' or `dolist' instead")) @@ -3340,7 +3367,8 @@ for symbols generated by the byte compiler itself." (when (symbolp var) (byte-compile-set-symbol-position var)) (cond ((or (not (symbolp var)) (macroexp--const-symbol-p var)) - (when (byte-compile-warning-enabled-p 'constants) + (when (byte-compile-warning-enabled-p 'constants + (and (symbolp var) var)) (byte-compile-warn (if (eq access-type 'let-bind) "attempt to let-bind %s `%s'" "variable reference to %s `%s'") @@ -3377,7 +3405,7 @@ for symbols generated by the byte compiler itself." ;; VAR is lexically bound (byte-compile-stack-ref (cdr lex-binding)) ;; VAR is dynamically bound - (unless (or (not (byte-compile-warning-enabled-p 'free-vars)) + (unless (or (not (byte-compile-warning-enabled-p 'free-vars var)) (boundp var) (memq var byte-compile-bound-variables) (memq var byte-compile-free-references)) @@ -3393,7 +3421,7 @@ for symbols generated by the byte compiler itself." ;; VAR is lexically bound. (byte-compile-stack-set (cdr lex-binding)) ;; VAR is dynamically bound. - (unless (or (not (byte-compile-warning-enabled-p 'free-vars)) + (unless (or (not (byte-compile-warning-enabled-p 'free-vars var)) (boundp var) (memq var byte-compile-bound-variables) (memq var byte-compile-free-assignments)) @@ -3878,7 +3906,7 @@ discarding." (defun byte-compile-function-form (form) (let ((f (nth 1 form))) (when (and (symbolp f) - (byte-compile-warning-enabled-p 'callargs)) + (byte-compile-warning-enabled-p 'callargs f)) (byte-compile-function-warn f t (byte-compile-fdefinition f nil))) (byte-compile-constant (if (eq 'lambda (car-safe f)) @@ -3948,7 +3976,8 @@ discarding." (let ((var (car-safe (cdr varexp)))) (and (or (not (symbolp var)) (macroexp--const-symbol-p var t)) - (byte-compile-warning-enabled-p 'constants) + (byte-compile-warning-enabled-p 'constants + (and (symbolp var) var)) (byte-compile-warn "variable assignment to %s `%s'" (if (symbolp var) "constant" "nonvariable") @@ -4609,7 +4638,7 @@ binding slots have been popped." (defun byte-compile-save-excursion (form) (if (and (eq 'set-buffer (car-safe (car-safe (cdr form)))) - (byte-compile-warning-enabled-p 'suspicious)) + (byte-compile-warning-enabled-p 'suspicious 'set-buffer)) (byte-compile-warn "Use `with-current-buffer' rather than save-excursion+set-buffer")) (byte-compile-out 'byte-save-excursion 0) @@ -4650,7 +4679,7 @@ binding slots have been popped." ;; This is not used for file-level defvar/consts. (when (and (symbolp (nth 1 form)) (not (string-match "[-*/:$]" (symbol-name (nth 1 form)))) - (byte-compile-warning-enabled-p 'lexical)) + (byte-compile-warning-enabled-p 'lexical (nth 1 form))) (byte-compile-warn "global/dynamic var `%s' lacks a prefix" (nth 1 form))) (let ((fun (nth 0 form)) @@ -4767,6 +4796,13 @@ binding slots have been popped." (let (byte-compile-warnings) (byte-compile-form (cons 'progn (cdr form))))) +(byte-defop-compiler-1 internal--with-suppressed-warnings + byte-compile-suppressed-warnings) +(defun byte-compile-suppressed-warnings (form) + (let ((byte-compile--suppressed-warnings + (append (cadadr form) byte-compile--suppressed-warnings))) + (byte-compile-form (macroexp-progn (cddr form))))) + ;; Warn about misuses of make-variable-buffer-local. (byte-defop-compiler-1 make-variable-buffer-local byte-compile-make-variable-buffer-local) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 83162d250fc..6fe7f5b571d 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -686,6 +686,96 @@ literals (Bug#20852)." (should-not (member '(byte-constant 333) lap)) (should (member '(byte-constant 444) lap))))) +(defun test-suppression (form suppress match) + (let ((lexical-binding t) + (byte-compile-log-buffer (generate-new-buffer " *Compile-Log*"))) + ;; Check that we get a warning without suppression. + (with-current-buffer byte-compile-log-buffer + (let ((inhibit-read-only t)) + (erase-buffer))) + (test-byte-comp-compile-and-load t form) + (with-current-buffer byte-compile-log-buffer + (unless match + (error "%s" (buffer-string))) + (goto-char (point-min)) + (should (re-search-forward match nil t))) + ;; And that it's gone now. + (with-current-buffer byte-compile-log-buffer + (let ((inhibit-read-only t)) + (erase-buffer))) + (test-byte-comp-compile-and-load t + `(with-suppressed-warnings ,suppress + ,form)) + (with-current-buffer byte-compile-log-buffer + (goto-char (point-min)) + (should-not (re-search-forward match nil t))) + ;; Also check that byte compiled forms are identical. + (should (equal (byte-compile form) + (byte-compile + `(with-suppressed-warnings ,suppress ,form)))))) + +(ert-deftest bytecomp-test--with-suppressed-warnings () + (test-suppression + '(defvar prefixless) + '((lexical prefixless)) + "global/dynamic var .prefixless. lacks") + + (test-suppression + '(defun foo() + (let ((nil t)) + (message-mail))) + '((constants nil)) + "Warning: attempt to let-bind constant .nil.") + + (test-suppression + '(progn + (defun obsolete () + (declare (obsolete foo "22.1"))) + (defun zot () + (obsolete))) + '((obsolete obsolete)) + "Warning: .obsolete. is an obsolete function") + + (test-suppression + '(progn + (defun wrong-params (foo &optional unused) + (ignore unused) + foo) + (defun zot () + (wrong-params 1 2 3))) + '((callargs wrong-params)) + "Warning: wrong-params called with") + + (test-byte-comp-compile-and-load nil + (defvar obsolete-variable nil) + (make-obsolete-variable 'obsolete-variable nil "24.1")) + (test-suppression + '(defun zot () + obsolete-variable) + '((obsolete obsolete-variable)) + "obsolete") + + (test-suppression + '(defun zot () + (mapcar #'list '(1 2 3)) + nil) + '((mapcar mapcar)) + "Warning: .mapcar. called for effect") + + (test-suppression + '(defun zot () + free-variable) + '((free-vars free-variable)) + "Warning: reference to free variable") + + (test-suppression + '(defun zot () + (save-excursion + (set-buffer (get-buffer-create "foo")) + nil)) + '((suspicious set-buffer)) + "Warning: Use .with-current-buffer. rather than")) + ;; Local Variables: ;; no-byte-compile: t ;; End: |