Warn about misplaced or duplicated function/macro declarations
Doc strings, `declare` and `interactive` forms must appear in that order and at most once each. Complain if they don't, instead of silently ignoring the problem (bug#55905). * lisp/emacs-lisp/byte-run.el (byte-run--parse-body) (byte-run--parse-declarations): New. (defmacro, defun): Check for declaration well-formedness as described above. Clarify doc strings. Refactor some common code. * test/lisp/emacs-lisp/bytecomp-resources/fun-attr-warn.el: * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-fun-attr-warn): New test.
This commit is contained in:
Mattias Engdegård
parent
e9c50055ff
commit
73e75e18d1
3 changed files with 446 additions and 91 deletions
|
|
@ -272,6 +272,75 @@ This is used by `declare'.")
|
|||
(list 'function-put (list 'quote name)
|
||||
''no-font-lock-keyword (list 'quote val))))
|
||||
|
||||
(defalias 'byte-run--parse-body
|
||||
#'(lambda (body allow-interactive)
|
||||
"Decompose BODY into (DOCSTRING DECLARE INTERACTIVE BODY-REST WARNINGS)."
|
||||
(let* ((top body)
|
||||
(docstring nil)
|
||||
(declare-form nil)
|
||||
(interactive-form nil)
|
||||
(warnings nil)
|
||||
(warn #'(lambda (msg form)
|
||||
(push (macroexp-warn-and-return msg nil nil t form)
|
||||
warnings))))
|
||||
(while
|
||||
(and body
|
||||
(let* ((form (car body))
|
||||
(head (car-safe form)))
|
||||
(cond
|
||||
((or (and (stringp form) (cdr body))
|
||||
(eq head :documentation))
|
||||
(cond
|
||||
(docstring (funcall warn "More than one doc string" top))
|
||||
(declare-form
|
||||
(funcall warn "Doc string after `declare'" declare-form))
|
||||
(interactive-form
|
||||
(funcall warn "Doc string after `interactive'"
|
||||
interactive-form))
|
||||
(t (setq docstring form)))
|
||||
t)
|
||||
((eq head 'declare)
|
||||
(cond
|
||||
(declare-form
|
||||
(funcall warn "More than one `declare' form" form))
|
||||
(interactive-form
|
||||
(funcall warn "`declare' after `interactive'" form))
|
||||
(t (setq declare-form form)))
|
||||
t)
|
||||
((eq head 'interactive)
|
||||
(cond
|
||||
((not allow-interactive)
|
||||
(funcall warn "No `interactive' form allowed here" form))
|
||||
(interactive-form
|
||||
(funcall warn "More than one `interactive' form" form))
|
||||
(t (setq interactive-form form)))
|
||||
t))))
|
||||
(setq body (cdr body)))
|
||||
(list docstring declare-form interactive-form body warnings))))
|
||||
|
||||
(defalias 'byte-run--parse-declarations
|
||||
#'(lambda (name arglist clauses construct declarations-alist)
|
||||
(let* ((cl-decls nil)
|
||||
(actions
|
||||
(mapcar
|
||||
#'(lambda (x)
|
||||
(let ((f (cdr (assq (car x) declarations-alist))))
|
||||
(cond
|
||||
(f (apply (car f) name arglist (cdr x)))
|
||||
;; Yuck!!
|
||||
((and (featurep 'cl)
|
||||
(memq (car x) ;C.f. cl--do-proclaim.
|
||||
'(special inline notinline optimize warn)))
|
||||
(push (list 'declare x) cl-decls)
|
||||
nil)
|
||||
(t
|
||||
(macroexp-warn-and-return
|
||||
(format-message "Unknown %s property `%S'"
|
||||
construct (car x))
|
||||
nil nil nil (car x))))))
|
||||
clauses)))
|
||||
(cons actions cl-decls))))
|
||||
|
||||
(defvar macro-declarations-alist
|
||||
(cons
|
||||
(list 'debug #'byte-run--set-debug)
|
||||
|
|
@ -289,7 +358,7 @@ This is used by `declare'.")
|
|||
(defalias 'defmacro
|
||||
(cons
|
||||
'macro
|
||||
#'(lambda (name arglist &optional docstring &rest body)
|
||||
#'(lambda (name arglist &rest body)
|
||||
"Define NAME as a macro.
|
||||
When the macro is called, as in (NAME ARGS...),
|
||||
the function (lambda ARGLIST BODY...) is applied to
|
||||
|
|
@ -300,115 +369,72 @@ DECLS is a list of elements of the form (PROP . VALUES). These are
|
|||
interpreted according to `macro-declarations-alist'.
|
||||
The return value is undefined.
|
||||
|
||||
\(fn NAME ARGLIST &optional DOCSTRING DECL &rest BODY)"
|
||||
;; We can't just have `decl' as an &optional argument, because we need
|
||||
;; to distinguish
|
||||
;; (defmacro foo (arg) (bar) nil)
|
||||
;; from
|
||||
;; (defmacro foo (arg) (bar)).
|
||||
(let ((decls (cond
|
||||
((eq (car-safe docstring) 'declare)
|
||||
(prog1 (cdr docstring) (setq docstring nil)))
|
||||
((and (stringp docstring)
|
||||
(eq (car-safe (car body)) 'declare))
|
||||
(prog1 (cdr (car body)) (setq body (cdr body)))))))
|
||||
(if docstring (setq body (cons docstring body))
|
||||
(if (null body) (setq body '(nil))))
|
||||
;; Can't use backquote because it's not defined yet!
|
||||
\(fn NAME ARGLIST [DOCSTRING] [DECL] BODY...)"
|
||||
(let* ((parse (byte-run--parse-body body nil))
|
||||
(docstring (nth 0 parse))
|
||||
(declare-form (nth 1 parse))
|
||||
(body (nth 3 parse))
|
||||
(warnings (nth 4 parse))
|
||||
(declarations
|
||||
(and declare-form (byte-run--parse-declarations
|
||||
name arglist (cdr declare-form) 'macro
|
||||
macro-declarations-alist))))
|
||||
(setq body (nconc warnings body))
|
||||
(setq body (nconc (cdr declarations) body))
|
||||
(if docstring
|
||||
(setq body (cons docstring body)))
|
||||
(if (null body)
|
||||
(setq body '(nil)))
|
||||
(let* ((fun (list 'function (cons 'lambda (cons arglist body))))
|
||||
(def (list 'defalias
|
||||
(list 'quote name)
|
||||
(list 'cons ''macro fun)))
|
||||
(declarations
|
||||
(mapcar
|
||||
#'(lambda (x)
|
||||
(let ((f (cdr (assq (car x) macro-declarations-alist))))
|
||||
(if f (apply (car f) name arglist (cdr x))
|
||||
(macroexp-warn-and-return
|
||||
(format-message
|
||||
"Unknown macro property %S in %S"
|
||||
(car x) name)
|
||||
nil nil nil (car x)))))
|
||||
decls)))
|
||||
;; Refresh font-lock if this is a new macro, or it is an
|
||||
;; existing macro whose 'no-font-lock-keyword declaration
|
||||
;; has changed.
|
||||
(if (and
|
||||
;; If lisp-mode hasn't been loaded, there's no reason
|
||||
;; to flush.
|
||||
(fboundp 'lisp--el-font-lock-flush-elisp-buffers)
|
||||
(or (not (fboundp name)) ;; new macro
|
||||
(and (fboundp name) ;; existing macro
|
||||
(member `(function-put ',name 'no-font-lock-keyword
|
||||
',(get name 'no-font-lock-keyword))
|
||||
declarations))))
|
||||
(lisp--el-font-lock-flush-elisp-buffers))
|
||||
(list 'cons ''macro fun))))
|
||||
(if declarations
|
||||
(cons 'prog1 (cons def declarations))
|
||||
(cons 'prog1 (cons def (car declarations)))
|
||||
def))))))
|
||||
|
||||
;; Now that we defined defmacro we can use it!
|
||||
(defmacro defun (name arglist &optional docstring &rest body)
|
||||
(defmacro defun (name arglist &rest body)
|
||||
"Define NAME as a function.
|
||||
The definition is (lambda ARGLIST [DOCSTRING] BODY...).
|
||||
See also the function `interactive'.
|
||||
The definition is (lambda ARGLIST [DOCSTRING] [INTERACTIVE] BODY...).
|
||||
DECL is a declaration, optional, of the form (declare DECLS...) where
|
||||
DECLS is a list of elements of the form (PROP . VALUES). These are
|
||||
interpreted according to `defun-declarations-alist'.
|
||||
INTERACTIVE is an optional `interactive' specification.
|
||||
The return value is undefined.
|
||||
|
||||
\(fn NAME ARGLIST &optional DOCSTRING DECL &rest BODY)"
|
||||
;; We can't just have `decl' as an &optional argument, because we need
|
||||
;; to distinguish
|
||||
;; (defun foo (arg) (toto) nil)
|
||||
;; from
|
||||
;; (defun foo (arg) (toto)).
|
||||
\(fn NAME ARGLIST [DOCSTRING] [DECL] [INTERACTIVE] BODY...)"
|
||||
(declare (doc-string 3) (indent 2))
|
||||
(or name (error "Cannot define '%s' as a function" name))
|
||||
(if (null
|
||||
(and (listp arglist)
|
||||
(null (delq t (mapcar #'symbolp arglist)))))
|
||||
(error "Malformed arglist: %s" arglist))
|
||||
(let ((decls (cond
|
||||
((eq (car-safe docstring) 'declare)
|
||||
(prog1 (cdr docstring) (setq docstring nil)))
|
||||
((and (stringp docstring)
|
||||
(eq (car-safe (car body)) 'declare))
|
||||
(prog1 (cdr (car body)) (setq body (cdr body)))))))
|
||||
(if docstring (setq body (cons docstring body))
|
||||
(if (null body) (setq body '(nil))))
|
||||
(let ((declarations
|
||||
(mapcar
|
||||
#'(lambda (x)
|
||||
(let ((f (cdr (assq (car x) defun-declarations-alist))))
|
||||
(cond
|
||||
(f (apply (car f) name arglist (cdr x)))
|
||||
;; Yuck!!
|
||||
((and (featurep 'cl)
|
||||
(memq (car x) ;C.f. cl-do-proclaim.
|
||||
'(special inline notinline optimize warn)))
|
||||
(push (list 'declare x)
|
||||
(if (stringp docstring)
|
||||
(if (eq (car-safe (cadr body)) 'interactive)
|
||||
(cddr body)
|
||||
(cdr body))
|
||||
(if (eq (car-safe (car body)) 'interactive)
|
||||
(cdr body)
|
||||
body)))
|
||||
nil)
|
||||
(t
|
||||
(macroexp-warn-and-return
|
||||
(format-message "Unknown defun property `%S' in %S"
|
||||
(car x) name)
|
||||
nil nil nil (car x))))))
|
||||
decls))
|
||||
(def (list 'defalias
|
||||
(let* ((parse (byte-run--parse-body body t))
|
||||
(docstring (nth 0 parse))
|
||||
(declare-form (nth 1 parse))
|
||||
(interactive-form (nth 2 parse))
|
||||
(body (nth 3 parse))
|
||||
(warnings (nth 4 parse))
|
||||
(declarations
|
||||
(and declare-form (byte-run--parse-declarations
|
||||
name arglist (cdr declare-form) 'defun
|
||||
defun-declarations-alist))))
|
||||
(setq body (nconc warnings body))
|
||||
(setq body (nconc (cdr declarations) body))
|
||||
(if interactive-form
|
||||
(setq body (cons interactive-form body)))
|
||||
(if docstring
|
||||
(setq body (cons docstring body)))
|
||||
(if (null body)
|
||||
(setq body '(nil)))
|
||||
(let ((def (list 'defalias
|
||||
(list 'quote name)
|
||||
(list 'function
|
||||
(cons 'lambda
|
||||
(cons arglist body))))))
|
||||
(if declarations
|
||||
(cons 'prog1 (cons def declarations))
|
||||
(cons 'prog1 (cons def (car declarations)))
|
||||
def))))
|
||||
|
||||
|
||||
|
|
|
|||
266
test/lisp/emacs-lisp/bytecomp-resources/fun-attr-warn.el
Normal file
266
test/lisp/emacs-lisp/bytecomp-resources/fun-attr-warn.el
Normal file
|
|
@ -0,0 +1,266 @@
|
|||
;;; -*- lexical-binding: t -*-
|
||||
|
||||
;; Correct
|
||||
|
||||
(defun faw-str-decl-code (x)
|
||||
"something"
|
||||
(declare (pure t))
|
||||
(print x))
|
||||
|
||||
(defun faw-doc-decl-code (x)
|
||||
(:documentation "something")
|
||||
(declare (pure t))
|
||||
(print x))
|
||||
|
||||
(defun faw-str-int-code (x)
|
||||
"something"
|
||||
(interactive "P")
|
||||
(print x))
|
||||
|
||||
(defun faw-doc-int-code (x)
|
||||
(:documentation "something")
|
||||
(interactive "P")
|
||||
(print x))
|
||||
|
||||
(defun faw-decl-int-code (x)
|
||||
(declare (pure t))
|
||||
(interactive "P")
|
||||
(print x))
|
||||
|
||||
(defun faw-str-decl-int-code (x)
|
||||
"something"
|
||||
(declare (pure t))
|
||||
(interactive "P")
|
||||
(print x))
|
||||
|
||||
(defun faw-doc-decl-int-code (x)
|
||||
(:documentation "something")
|
||||
(declare (pure t))
|
||||
(interactive "P")
|
||||
(print x))
|
||||
|
||||
|
||||
;; Correct (last string is return value)
|
||||
|
||||
(defun faw-str ()
|
||||
"something")
|
||||
|
||||
(defun faw-decl-str ()
|
||||
(declare (pure t))
|
||||
"something")
|
||||
|
||||
(defun faw-decl-int-str ()
|
||||
(declare (pure t))
|
||||
(interactive)
|
||||
"something")
|
||||
|
||||
(defun faw-str-str ()
|
||||
"something"
|
||||
"something else")
|
||||
|
||||
(defun faw-doc-str ()
|
||||
(:documentation "something")
|
||||
"something else")
|
||||
|
||||
|
||||
;; Incorrect (bad order)
|
||||
|
||||
(defun faw-int-decl-code (x)
|
||||
(interactive "P")
|
||||
(declare (pure t))
|
||||
(print x))
|
||||
|
||||
(defun faw-int-str-code (x)
|
||||
(interactive "P")
|
||||
"something"
|
||||
(print x))
|
||||
|
||||
(defun faw-int-doc-code (x)
|
||||
(interactive "P")
|
||||
(:documentation "something")
|
||||
(print x))
|
||||
|
||||
(defun faw-decl-str-code (x)
|
||||
(declare (pure t))
|
||||
"something"
|
||||
(print x))
|
||||
|
||||
(defun faw-decl-doc-code (x)
|
||||
(declare (pure t))
|
||||
(:documentation "something")
|
||||
(print x))
|
||||
|
||||
(defun faw-str-int-decl-code (x)
|
||||
"something"
|
||||
(interactive "P")
|
||||
(declare (pure t))
|
||||
(print x))
|
||||
|
||||
(defun faw-doc-int-decl-code (x)
|
||||
(:documentation "something")
|
||||
(interactive "P")
|
||||
(declare (pure t))
|
||||
(print x))
|
||||
|
||||
(defun faw-int-str-decl-code (x)
|
||||
(interactive "P")
|
||||
"something"
|
||||
(declare (pure t))
|
||||
(print x))
|
||||
|
||||
(defun faw-int-doc-decl-code (x)
|
||||
(interactive "P")
|
||||
(:documentation "something")
|
||||
(declare (pure t))
|
||||
(print x))
|
||||
|
||||
(defun faw-int-decl-str-code (x)
|
||||
(interactive "P")
|
||||
(declare (pure t))
|
||||
"something"
|
||||
(print x))
|
||||
|
||||
(defun faw-int-decl-doc-code (x)
|
||||
(interactive "P")
|
||||
(declare (pure t))
|
||||
(:documentation "something")
|
||||
(print x))
|
||||
|
||||
(defun faw-decl-int-str-code (x)
|
||||
(declare (pure t))
|
||||
(interactive "P")
|
||||
"something"
|
||||
(print x))
|
||||
|
||||
(defun faw-decl-int-doc-code (x)
|
||||
(declare (pure t))
|
||||
(interactive "P")
|
||||
(:documentation "something")
|
||||
(print x))
|
||||
|
||||
(defun faw-decl-str-int-code (x)
|
||||
(declare (pure t))
|
||||
"something"
|
||||
(interactive "P")
|
||||
(print x))
|
||||
|
||||
(defun faw-decl-doc-int-code (x)
|
||||
(declare (pure t))
|
||||
(:documentation "something")
|
||||
(interactive "P")
|
||||
(print x))
|
||||
|
||||
|
||||
;; Incorrect (duplication)
|
||||
|
||||
(defun faw-str-str-decl-int-code (x)
|
||||
"something"
|
||||
"something else"
|
||||
(declare (pure t))
|
||||
(interactive "P")
|
||||
(print x))
|
||||
|
||||
(defun faw-str-doc-decl-int-code (x)
|
||||
"something"
|
||||
(:documentation "something else")
|
||||
(declare (pure t))
|
||||
(interactive "P")
|
||||
(print x))
|
||||
|
||||
(defun faw-doc-str-decl-int-code (x)
|
||||
(:documentation "something")
|
||||
"something else"
|
||||
(declare (pure t))
|
||||
(interactive "P")
|
||||
(print x))
|
||||
|
||||
(defun faw-doc-doc-decl-int-code (x)
|
||||
(:documentation "something")
|
||||
(:documentation "something else")
|
||||
(declare (pure t))
|
||||
(interactive "P")
|
||||
(print x))
|
||||
|
||||
(defun faw-str-decl-str-int-code (x)
|
||||
"something"
|
||||
(declare (pure t))
|
||||
"something else"
|
||||
(interactive "P")
|
||||
(print x))
|
||||
|
||||
(defun faw-doc-decl-str-int-code (x)
|
||||
(:documentation "something")
|
||||
(declare (pure t))
|
||||
"something else"
|
||||
(interactive "P")
|
||||
(print x))
|
||||
|
||||
(defun faw-str-decl-doc-int-code (x)
|
||||
"something"
|
||||
(declare (pure t))
|
||||
(:documentation "something else")
|
||||
(interactive "P")
|
||||
(print x))
|
||||
|
||||
(defun faw-doc-decl-doc-int-code (x)
|
||||
(:documentation "something")
|
||||
(declare (pure t))
|
||||
(:documentation "something else")
|
||||
(interactive "P")
|
||||
(print x))
|
||||
|
||||
(defun faw-str-decl-decl-int-code (x)
|
||||
"something"
|
||||
(declare (pure t))
|
||||
(declare (indent 1))
|
||||
(interactive "P")
|
||||
(print x))
|
||||
|
||||
(defun faw-doc-decl-decl-int-code (x)
|
||||
(:documentation "something")
|
||||
(declare (pure t))
|
||||
(declare (indent 1))
|
||||
(interactive "P")
|
||||
(print x))
|
||||
|
||||
(defun faw-str-decl-int-decl-code (x)
|
||||
"something"
|
||||
(declare (pure t))
|
||||
(interactive "P")
|
||||
(declare (indent 1))
|
||||
(print x))
|
||||
|
||||
(defun faw-doc-decl-int-decl-code (x)
|
||||
(:documentation "something")
|
||||
(declare (pure t))
|
||||
(interactive "P")
|
||||
(declare (indent 1))
|
||||
(print x))
|
||||
|
||||
(defun faw-str-decl-int-int-code (x)
|
||||
"something"
|
||||
(declare (pure t))
|
||||
(interactive "P")
|
||||
(interactive "p")
|
||||
(print x))
|
||||
|
||||
(defun faw-doc-decl-int-int-code (x)
|
||||
(:documentation "something")
|
||||
(declare (pure t))
|
||||
(interactive "P")
|
||||
(interactive "p")
|
||||
(print x))
|
||||
|
||||
(defun faw-str-int-decl-int-code (x)
|
||||
"something"
|
||||
(interactive "P")
|
||||
(declare (pure t))
|
||||
(interactive "p")
|
||||
(print x))
|
||||
|
||||
(defun faw-doc-int-decl-int-code (x)
|
||||
(:documentation "something")
|
||||
(interactive "P")
|
||||
(declare (pure t))
|
||||
(interactive "p")
|
||||
(print x))
|
||||
|
|
@ -1580,6 +1580,69 @@ EXPECTED-POINT BINDINGS (MODES \\='\\='(ruby-mode js-mode python-mode)) \
|
|||
(should (equal (get fname 'lisp-indent-function) 1))
|
||||
(should (equal (aref bc 4) "tata\n\n(fn X)")))))
|
||||
|
||||
(ert-deftest bytecomp-fun-attr-warn ()
|
||||
;; Check that warnings are emitted when doc strings, `declare' and
|
||||
;; `interactive' forms don't come in the proper order, or more than once.
|
||||
(let* ((filename "fun-attr-warn.el")
|
||||
(el (ert-resource-file filename))
|
||||
(elc (concat el "c"))
|
||||
(text-quoting-style 'grave))
|
||||
(with-current-buffer (get-buffer-create "*Compile-Log*")
|
||||
(let ((inhibit-read-only t))
|
||||
(erase-buffer))
|
||||
(byte-compile-file el)
|
||||
(let ((expected
|
||||
'("70:4: Warning: `declare' after `interactive'"
|
||||
"74:4: Warning: Doc string after `interactive'"
|
||||
"79:4: Warning: Doc string after `interactive'"
|
||||
"84:4: Warning: Doc string after `declare'"
|
||||
"89:4: Warning: Doc string after `declare'"
|
||||
"96:4: Warning: `declare' after `interactive'"
|
||||
"102:4: Warning: `declare' after `interactive'"
|
||||
"108:4: Warning: `declare' after `interactive'"
|
||||
"106:4: Warning: Doc string after `interactive'"
|
||||
"114:4: Warning: `declare' after `interactive'"
|
||||
"112:4: Warning: Doc string after `interactive'"
|
||||
"118:4: Warning: Doc string after `interactive'"
|
||||
"119:4: Warning: `declare' after `interactive'"
|
||||
"124:4: Warning: Doc string after `interactive'"
|
||||
"125:4: Warning: `declare' after `interactive'"
|
||||
"130:4: Warning: Doc string after `declare'"
|
||||
"136:4: Warning: Doc string after `declare'"
|
||||
"142:4: Warning: Doc string after `declare'"
|
||||
"148:4: Warning: Doc string after `declare'"
|
||||
"159:4: Warning: More than one doc string"
|
||||
"165:4: Warning: More than one doc string"
|
||||
"171:4: Warning: More than one doc string"
|
||||
"178:4: Warning: More than one doc string"
|
||||
"186:4: Warning: More than one doc string"
|
||||
"192:4: Warning: More than one doc string"
|
||||
"200:4: Warning: More than one doc string"
|
||||
"206:4: Warning: More than one doc string"
|
||||
"215:4: Warning: More than one `declare' form"
|
||||
"222:4: Warning: More than one `declare' form"
|
||||
"230:4: Warning: More than one `declare' form"
|
||||
"237:4: Warning: More than one `declare' form"
|
||||
"244:4: Warning: More than one `interactive' form"
|
||||
"251:4: Warning: More than one `interactive' form"
|
||||
"258:4: Warning: More than one `interactive' form"
|
||||
"257:4: Warning: `declare' after `interactive'"
|
||||
"265:4: Warning: More than one `interactive' form"
|
||||
"264:4: Warning: `declare' after `interactive'")))
|
||||
(goto-char (point-min))
|
||||
(let ((actual nil))
|
||||
(while (re-search-forward
|
||||
(rx bol (* (not ":")) ":"
|
||||
(group (+ digit) ":" (+ digit) ": Warning: "
|
||||
(or "More than one " (+ nonl) " form"
|
||||
(: (+ nonl) " after " (+ nonl))))
|
||||
eol)
|
||||
nil t)
|
||||
(push (match-string 1) actual))
|
||||
(setq actual (nreverse actual))
|
||||
(should (equal actual expected)))))))
|
||||
|
||||
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue