From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Spencer Baugh Newsgroups: gmane.emacs.bugs Subject: bug#66326: 29.1.50; There should be a way to promote warnings to errors Date: Tue, 03 Oct 2023 14:39:02 -0400 Message-ID: References: Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="2763"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) To: 66326@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Tue Oct 03 20:40:00 2023 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1qnkJM-0000LY-9Y for geb-bug-gnu-emacs@m.gmane-mx.org; Tue, 03 Oct 2023 20:40:00 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qnkJB-0006N4-7g; Tue, 03 Oct 2023 14:39:49 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1qnkJ8-0006Mv-Dn for bug-gnu-emacs@gnu.org; Tue, 03 Oct 2023 14:39:46 -0400 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1qnkJ6-0003ZC-Rc for bug-gnu-emacs@gnu.org; Tue, 03 Oct 2023 14:39:46 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1qnkJN-00025f-OE for bug-gnu-emacs@gnu.org; Tue, 03 Oct 2023 14:40:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Spencer Baugh Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 03 Oct 2023 18:40:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 66326 X-GNU-PR-Package: emacs Original-Received: via spool by 66326-submit@debbugs.gnu.org id=B66326.16963583687986 (code B ref 66326); Tue, 03 Oct 2023 18:40:01 +0000 Original-Received: (at 66326) by debbugs.gnu.org; 3 Oct 2023 18:39:28 +0000 Original-Received: from localhost ([127.0.0.1]:40705 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qnkIq-00024k-2a for submit@debbugs.gnu.org; Tue, 03 Oct 2023 14:39:28 -0400 Original-Received: from mxout5.mail.janestreet.com ([64.215.233.18]:53495) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qnkIo-00024T-2u for 66326@debbugs.gnu.org; Tue, 03 Oct 2023 14:39:26 -0400 In-Reply-To: (Spencer Baugh's message of "Tue, 03 Oct 2023 12:38:18 -0400") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:271728 Archived-At: --=-=-= Content-Type: text/plain Patch implementing this: --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-Support-turning-warnings-into-errors.patch >From 6fad83ea8729569c968ccdfc1ec2807387bc979e Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Tue, 3 Oct 2023 14:36:25 -0400 Subject: [PATCH] Support turning warnings into errors Support turning warnings into errors in a user-configurable way. This is especially useful in combination with (setq debug-on-error t) to drop to the debugger when a warning happens. * lisp/emacs-lisp/warnings.el (warning-suppress-types): Improve docstring. (warning-to-error-types, warning-to-error): Add. (display-warning): Check warning-to-error-types. --- lisp/emacs-lisp/warnings.el | 209 ++++++++++++++++++++---------------- 1 file changed, 114 insertions(+), 95 deletions(-) diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el index 31b840d6c83..9e0a35b87bb 100644 --- a/lisp/emacs-lisp/warnings.el +++ b/lisp/emacs-lisp/warnings.el @@ -114,11 +114,20 @@ warning-suppress-types The element must match an initial segment of the list TYPE. Thus, (foo bar) as an element matches (foo bar) or (foo bar ANYTHING...) as TYPE. +An empty list as an element matches any TYPE. If TYPE is a symbol FOO, that is equivalent to the list (FOO), so only the element (FOO) will match it. See also `warning-suppress-log-types'." :type '(repeat (repeat symbol)) :version "22.1") + +(defcustom warning-to-error-types nil + "List of warning types to signal as an error instead. +If any element of this list matches the TYPE argument to `display-warning', +an error is signaled instead of logging a warning. +See `warning-suppress-types' for the format of elements in this list." + :type '(repeat (repeat symbol)) + :version "30.1") ;; The autoload cookie is so that programs can bind this variable ;; safely, testing the existing value, before they call one of the @@ -230,6 +239,12 @@ warnings-suppress (cons (list type) warning-suppress-types))) (_ (message "Exiting")))) +(defun warning-to-error (type message level) + (let* ((typename (if (consp type) (car type) type)) + (level-info (assq level warning-levels))) + (error (nth 1 level-info) + (format warning-type-format typename)))) + ;;;###autoload (defun display-warning (type message &optional level buffer-name) "Display a warning message, MESSAGE. @@ -263,105 +278,109 @@ display-warning disable automatic display of the warning or disable the warning entirely by setting `warning-suppress-types' or `warning-suppress-log-types' on their behalf." - (if (not (or after-init-time noninteractive (daemonp))) - ;; Ensure warnings that happen early in the startup sequence - ;; are visible when startup completes (bug#20792). - (delay-warning type message level buffer-name) - (unless level - (setq level :warning)) - (unless buffer-name - (setq buffer-name "*Warnings*")) + (unless level + (setq level :warning)) + (unless buffer-name + (setq buffer-name "*Warnings*")) + (cond + ((< (warning-numeric-level level) + (warning-numeric-level warning-minimum-log-level))) + ((warning-suppress-p type warning-suppress-log-types)) + ((warning-suppress-p type warning-to-error-types) + (warning-to-error type message level)) + ((not (or after-init-time noninteractive (daemonp))) + ;; Ensure warnings that happen early in the startup sequence + ;; are visible when startup completes (bug#20792). + (delay-warning type message level buffer-name)) + (t (with-suppressed-warnings ((obsolete warning-level-aliases)) (when-let ((new (cdr (assq level warning-level-aliases)))) (warn "Warning level `%s' is obsolete; use `%s' instead" level new) (setq level new))) - (or (< (warning-numeric-level level) - (warning-numeric-level warning-minimum-log-level)) - (warning-suppress-p type warning-suppress-log-types) - (let* ((typename (if (consp type) (car type) type)) - (old (get-buffer buffer-name)) - (buffer (or old (get-buffer-create buffer-name))) - (level-info (assq level warning-levels)) - ;; `newline' may be unbound during bootstrap. - (newline (if (fboundp 'newline) #'newline - (lambda () (insert "\n")))) - start end) - (with-current-buffer buffer - ;; If we created the buffer, disable undo. - (unless old - (when (fboundp 'special-mode) ; Undefined during bootstrap. - (special-mode)) - (setq buffer-read-only t) - (setq buffer-undo-list t)) - (goto-char (point-max)) - (when (and warning-series (symbolp warning-series)) - (setq warning-series - (prog1 (point-marker) - (unless (eq warning-series t) - (funcall warning-series))))) - (let ((inhibit-read-only t)) - (unless (bolp) - (funcall newline)) - (setq start (point)) - ;; Don't output the button when doing batch compilation - ;; and similar. - (unless (or noninteractive (eq type 'bytecomp)) - (insert (buttonize (icon-string 'warnings-suppress) - #'warnings-suppress type) - " ")) - (if warning-prefix-function - (setq level-info (funcall warning-prefix-function - level level-info))) - (insert (format (nth 1 level-info) - (format warning-type-format typename)) - message) - (funcall newline) - (when (and warning-fill-prefix - (not (string-search "\n" message)) - (not noninteractive)) - (let ((fill-prefix warning-fill-prefix) - (fill-column warning-fill-column)) - (fill-region start (point)))) - (setq end (point))) - (when (and (markerp warning-series) - (eq (marker-buffer warning-series) buffer)) - (goto-char warning-series))) - (if (nth 2 level-info) - (funcall (nth 2 level-info))) - (cond (noninteractive - ;; Noninteractively, take the text we inserted - ;; in the warnings buffer and print it. - ;; Do this unconditionally, since there is no way - ;; to view logged messages unless we output them. - (with-current-buffer buffer - (save-excursion - ;; Don't include the final newline in the arg - ;; to `message', because it adds a newline. - (goto-char end) - (if (bolp) - (forward-char -1)) - (message "%s" (buffer-substring start (point)))))) - ((and (daemonp) (null after-init-time)) - ;; Warnings assigned during daemon initialization go into - ;; the messages buffer. - (message "%s" - (with-current-buffer buffer - (save-excursion - (goto-char end) - (if (bolp) - (forward-char -1)) - (buffer-substring start (point)))))) - (t - ;; Interactively, decide whether the warning merits - ;; immediate display. - (or (< (warning-numeric-level level) - (warning-numeric-level warning-minimum-level)) - (warning-suppress-p type warning-suppress-types) - (let ((window (display-buffer buffer))) - (when (and (markerp warning-series) - (eq (marker-buffer warning-series) buffer)) - (set-window-start window warning-series)) - (sit-for 0))))))))) + (let* ((typename (if (consp type) (car type) type)) + (old (get-buffer buffer-name)) + (buffer (or old (get-buffer-create buffer-name))) + (level-info (assq level warning-levels)) + ;; `newline' may be unbound during bootstrap. + (newline (if (fboundp 'newline) #'newline + (lambda () (insert "\n")))) + start end) + (with-current-buffer buffer + ;; If we created the buffer, disable undo. + (unless old + (when (fboundp 'special-mode) ; Undefined during bootstrap. + (special-mode)) + (setq buffer-read-only t) + (setq buffer-undo-list t)) + (goto-char (point-max)) + (when (and warning-series (symbolp warning-series)) + (setq warning-series + (prog1 (point-marker) + (unless (eq warning-series t) + (funcall warning-series))))) + (let ((inhibit-read-only t)) + (unless (bolp) + (funcall newline)) + (setq start (point)) + ;; Don't output the button when doing batch compilation + ;; and similar. + (unless (or noninteractive (eq type 'bytecomp)) + (insert (buttonize (icon-string 'warnings-suppress) + #'warnings-suppress type) + " ")) + (if warning-prefix-function + (setq level-info (funcall warning-prefix-function + level level-info))) + (insert (format (nth 1 level-info) + (format warning-type-format typename)) + message) + (funcall newline) + (when (and warning-fill-prefix + (not (string-search "\n" message)) + (not noninteractive)) + (let ((fill-prefix warning-fill-prefix) + (fill-column warning-fill-column)) + (fill-region start (point)))) + (setq end (point))) + (when (and (markerp warning-series) + (eq (marker-buffer warning-series) buffer)) + (goto-char warning-series))) + (if (nth 2 level-info) + (funcall (nth 2 level-info))) + (cond (noninteractive + ;; Noninteractively, take the text we inserted + ;; in the warnings buffer and print it. + ;; Do this unconditionally, since there is no way + ;; to view logged messages unless we output them. + (with-current-buffer buffer + (save-excursion + ;; Don't include the final newline in the arg + ;; to `message', because it adds a newline. + (goto-char end) + (if (bolp) + (forward-char -1)) + (message "%s" (buffer-substring start (point)))))) + ((and (daemonp) (null after-init-time)) + ;; Warnings assigned during daemon initialization go into + ;; the messages buffer. + (message "%s" + (with-current-buffer buffer + (save-excursion + (goto-char end) + (if (bolp) + (forward-char -1)) + (buffer-substring start (point)))))) + (t + ;; Interactively, decide whether the warning merits + ;; immediate display. + (or (< (warning-numeric-level level) + (warning-numeric-level warning-minimum-level)) + (warning-suppress-p type warning-suppress-types) + (let ((window (display-buffer buffer))) + (when (and (markerp warning-series) + (eq (marker-buffer warning-series) buffer)) + (set-window-start window warning-series)) + (sit-for 0))))))))) ;; Use \\ so that help-enable-autoload can do its thing. ;; Any keymap that is defined will do. -- 2.39.3 --=-=-=--