procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Clean up defcustom type quote check

Browse source 
* lisp/emacs-lisp/bytecomp.el
(byte-compile--suspicious-defcustom-choice): Rename to...
(byte-compile--defcustom-type-quoted): ...this and rewrite to make
more sense.  All callers updated.
(byte-compile-nogroup-warn): Better warning message.
* test/lisp/emacs-lisp/bytecomp-tests.el
(test-bytecomp-defgroup-choice): This never failed because it wasn't
actually a test.  Turn it into...
(bytecomp-test-defcustom-type-quoted): ...this, which is.
This commit is contained in:
Mattias Engdegård 2023-05-29 17:49:48 +02:00
parent f8a79c0055
commit 08291e6f17
2 changed files with 18 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

29
lisp/emacs-lisp/bytecomp.el
View file

@ -1619,21 +1619,20 @@ extra args."
(dolist (elt '(format message 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)).
(defun byte-compile--defcustom-type-quoted (type)
"Whether defcustom TYPE contains an accidentally quoted value."
;; Detect mistakes such as (const 'abc).
;; 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)))
(and (consp type)
(proper-list-p type)
(if (memq (car type) '(const other))
(assq 'quote type)
(let ((elts (cdr type)))
(while (and elts (not (byte-compile--defcustom-type-quoted
(car elts))))
(setq elts (cdr elts)))
elts))))
;; Warn if a custom definition fails to specify :group, or :type.
(defun byte-compile-nogroup-warn (form)
@ -1647,10 +1646,10 @@ extra args."
(byte-compile-warn-x (cadr name)
"defcustom for `%s' fails to specify type"
(cadr name)))
((byte-compile--suspicious-defcustom-choice type)
((byte-compile--defcustom-type-quoted type)
(byte-compile-warn-x
(cadr name)
"defcustom for `%s' has syntactically odd type `%s'"
"defcustom for `%s' may have accidentally quoted value in type `%s'"
(cadr name) type)))))
(if (and (memq (car form) '(custom-declare-face custom-declare-variable))
byte-compile-current-group)

8
test/lisp/emacs-lisp/bytecomp-tests.el
View file

@ -1799,11 +1799,11 @@ 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
(ert-deftest bytecomp-test-defcustom-type-quoted ()
(should-not (byte-compile--defcustom-type-quoted 'integer))
(should-not (byte-compile--defcustom-type-quoted
'(choice (const :tag "foo" bar))))
(should (byte-compile--suspicious-defcustom-choice
(should (byte-compile--defcustom-type-quoted
'(choice (const :tag "foo" 'bar)))))
(ert-deftest bytecomp-function-attributes ()