Commit f2071b6d authored by Lars Ingebrigtsen's avatar Lars Ingebrigtsen

Add the new macro with-suppressed-warnings

* lisp/emacs-lisp/byte-run.el (with-suppressed-warnings): New macro.

* doc/lispref/compile.texi (Compiler Errors): Document
with-suppressed-warnings and deemphasise with-no-warnings
slightly.

* lisp/emacs-lisp/bytecomp.el (byte-compile--suppressed-warnings):
New internal variable.
(byte-compile-warning-enabled-p): Heed
byte-compile--suppressed-warnings, bound via with-suppressed-warnings.
(byte-compile-initial-macro-environment): Provide a macro
expansion of with-suppressed-warnings.
(byte-compile-file-form-with-suppressed-warnings): New byte hunk
handler for the suppressed symbol machinery.
(byte-compile-suppressed-warnings): Ditto for the byteop.
(byte-compile-file-form-defmumble): Ditto.
(byte-compile-form, byte-compile-normal-call)
(byte-compile-normal-call, byte-compile-variable-ref)
(byte-compile-set-default, byte-compile-variable-set)
(byte-compile-function-form, byte-compile-set-default)
(byte-compile-warn-obsolete, byte-compile--declare-var): Pass the
symbol being warned in to byte-compile-warning-enabled-p.

* test/lisp/emacs-lisp/bytecomp-tests.el (test-suppression): New
function.
(bytecomp-test--with-suppressed-warnings): Tests.
parent b8350e52
Pipeline #2005 failed with stage
in 8 seconds
......@@ -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
......
......@@ -1692,6 +1692,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,
......
......@@ -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.
......
......@@ -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)
......
......@@ -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:
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment