master 231cf5ee2b 4/4: Warn about quoted symbols in defcustom choice/other forms

[Lars Ingebrigtsen]

branch: master
commit 231cf5ee2bed8a2b574ad424b624b36c0ee0733f
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Warn about quoted symbols in defcustom choice/other forms
    
    * lisp/emacs-lisp/bytecomp.el
    (byte-compile--suspicious-defcustom-choice): New function (bug#16271).
    (byte-compile-nogroup-warn): Use it to warn about forms like
    (choice (const :tag "foo" 'bar)).
---
 etc/NEWS                               | 13 +++++++++++++
 lisp/emacs-lisp/bytecomp.el            | 32 ++++++++++++++++++++++++++++----
 test/lisp/emacs-lisp/bytecomp-tests.el |  6 ++++++
 3 files changed, 47 insertions(+), 4 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index a0164bbf3f..595e477e2f 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1767,6 +1767,19 @@ functions.
 
 * Lisp Changes in Emacs 29.1
 
+** Byte compilation
+
+---
+*** Byte compilation will now warn about some malformed 'defcustom' types.
+It's very common to write 'defcustom' types on the form:
+
+   :type '(choice (const :tag "foo" 'bar))
+
+I.e., double-quoting the 'bar', which is almost never the correct
+value.  The byte compiler will now issue a warning if it encounters
+these forms.
+
+
 +++
 *** 'restore-buffer-modified-p' can now alter buffer auto-save state.
 With a FLAG value of 'autosaved', it will mark the buffer as having
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index c0dffe544c..cbf2659109 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1562,15 +1562,39 @@ extra args."
 (dolist (elt '(format message error))
   (put elt 'byte-compile-format-like t))
 
+(defun byte-compile--suspicious-defcustom-choice (type)
+  "Say whether defcustom TYPE looks odd."
+  ;; Check whether there's anything like (choice (const :tag "foo" ;; 'bar)).
+  ;; We don't actually follow the syntax for defcustom types, but this
+  ;; should be good enough.
+  (catch 'found
+    (if (and (consp type)
+             (proper-list-p type))
+        (if (memq (car type) '(const other))
+            (when (assq 'quote type)
+              (throw 'found t))
+          (when (memq t (mapcar #'byte-compile--suspicious-defcustom-choice
+                                type))
+            (throw 'found t)))
+      nil)))
+
 ;; Warn if a custom definition fails to specify :group, or :type.
 (defun byte-compile-nogroup-warn (form)
   (let ((keyword-args (cdr (cdr (cdr (cdr form)))))
        (name (cadr form)))
     (when (eq (car-safe name) 'quote)
-      (or (not (eq (car form) 'custom-declare-variable))
-         (plist-get keyword-args :type)
-         (byte-compile-warn-x (cadr name)
-          "defcustom for `%s' fails to specify type" (cadr name)))
+      (when (eq (car form) 'custom-declare-variable)
+        (let ((type (plist-get keyword-args :type)))
+         (cond
+           ((not type)
+           (byte-compile-warn-x (cadr name)
+                                "defcustom for `%s' fails to specify type"
+                                 (cadr name)))
+           ((byte-compile--suspicious-defcustom-choice type)
+           (byte-compile-warn-x
+             (cadr name)
+            "defcustom for `%s' has syntactically odd type `%s'"
+             (cadr name) type)))))
       (if (and (memq (car form) '(custom-declare-face custom-declare-variable))
               byte-compile-current-group)
          ;; The group will be provided implicitly.
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el 
b/test/lisp/emacs-lisp/bytecomp-tests.el
index abd33ab8e5..051e8b9e5c 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -1538,6 +1538,12 @@ EXPECTED-POINT BINDINGS (MODES \\='\\='(ruby-mode 
js-mode python-mode)) \
 (TEST-IN-COMMENTS t) (TEST-IN-STRINGS t) (TEST-IN-CODE t) \
 (FIXTURE-FN \\='#\\='electric-pair-mode))" fill-column)))
 
+(defun test-bytecomp-defgroup-choice ()
+  (should-not (byte-compile--suspicious-defcustom-choice 'integer))
+  (should-not (byte-compile--suspicious-defcustom-choice
+               '(choice (const :tag "foo" bar))))
+  (should (byte-compile--suspicious-defcustom-choice
+           '(choice (const :tag "foo" 'bar)))))
 
 ;; Local Variables:
 ;; no-byte-compile: t