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.

lisp/emacs-lisp/byte-run.el

@@ -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)"
+\(fn NAME ARGLIST [DOCSTRING] [DECL] BODY...)"
-       ;; We can't just have `decl' as an &optional argument, because we need
+       (let* ((parse (byte-run--parse-body body nil))
-       ;; to distinguish
+              (docstring (nth 0 parse))
-       ;;    (defmacro foo (arg) (bar) nil)
+              (declare-form (nth 1 parse))
-       ;; from
+              (body (nth 3 parse))
-       ;;    (defmacro foo (arg) (bar)).
+              (warnings (nth 4 parse))
-       (let ((decls (cond
+              (declarations
-		     ((eq (car-safe docstring) 'declare)
+               (and declare-form (byte-run--parse-declarations
-		      (prog1 (cdr docstring) (setq docstring nil)))
+                                  name arglist (cdr declare-form) 'macro
-		     ((and (stringp docstring)
+                                  macro-declarations-alist))))
-			   (eq (car-safe (car body)) 'declare))
+         (setq body (nconc warnings body))
-		      (prog1 (cdr (car body)) (setq body (cdr body)))))))
+         (setq body (nconc (cdr declarations) body))
-	 (if docstring (setq body (cons docstring body))
+         (if docstring
-	   (if (null body) (setq body '(nil))))
+             (setq body (cons docstring body)))
-	 ;; Can't use backquote because it's not defined yet!
+         (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)))
+		           (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))
            (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...).
+The definition is (lambda ARGLIST [DOCSTRING] [INTERACTIVE] BODY...).
-See also the function `interactive'.
 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)"
+\(fn NAME ARGLIST [DOCSTRING] [DECL] [INTERACTIVE] 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)).
   (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
+  (let* ((parse (byte-run--parse-body body t))
-                ((eq (car-safe docstring) 'declare)
+         (docstring (nth 0 parse))
-                 (prog1 (cdr docstring) (setq docstring nil)))
+         (declare-form (nth 1 parse))
-                ((and (stringp docstring)
+         (interactive-form (nth 2 parse))
-		      (eq (car-safe (car body)) 'declare))
+         (body (nth 3 parse))
-                 (prog1 (cdr (car body)) (setq body (cdr body)))))))
+         (warnings (nth 4 parse))
-    (if docstring (setq body (cons docstring body))
+         (declarations
-      (if (null body) (setq body '(nil))))
+          (and declare-form (byte-run--parse-declarations
-    (let ((declarations
+                             name arglist (cdr declare-form) 'defun
-           (mapcar
+                             defun-declarations-alist))))
-            #'(lambda (x)
+    (setq body (nconc warnings body))
-                (let ((f (cdr (assq (car x) defun-declarations-alist))))
+    (setq body (nconc (cdr declarations) body))
-                  (cond
+    (if interactive-form
-                   (f (apply (car f) name arglist (cdr x)))
+        (setq body (cons interactive-form body)))
-                   ;; Yuck!!
+    (if docstring
-                   ((and (featurep 'cl)
+        (setq body (cons docstring body)))
-                         (memq (car x)  ;C.f. cl-do-proclaim.
+    (if (null body)
-                               '(special inline notinline optimize warn)))
+        (setq body '(nil)))
-                    (push (list 'declare x)
+    (let ((def (list 'defalias
-                          (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
                      (list 'quote name)
                      (list 'function
                            (cons 'lambda
                                  (cons arglist body))))))
       (if declarations
-          (cons 'prog1 (cons def declarations))
+          (cons 'prog1 (cons def (car declarations)))
         def))))
 
 

test/lisp/emacs-lisp/bytecomp-resources/fun-attr-warn.el

@@ -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))

test/lisp/emacs-lisp/bytecomp-tests.el

@@ -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: