scratch/bug-44858 e491d97 3/6: Avoid false positives in bytecomp docstring width warning

[Stefan Kangas]

branch: scratch/bug-44858
commit e491d9727eb486f86ccc684c8747067790b50d31
Author: Stefan Kangas <stefan@marxist.se>
Commit: Stefan Kangas <stefan@marxist.se>

    Avoid false positives in bytecomp docstring width warning
    
    * lisp/emacs-lisp/bytecomp.el (byte-compile--wide-docstring-p):
    Ignore more function argument lists.
    * test/lisp/emacs-lisp/bytecomp-tests.el
    (bytecomp-tests-byte-compile--wide-docstring-p): New test.
---
 lisp/emacs-lisp/bytecomp.el            | 12 ++++++++++--
 test/lisp/emacs-lisp/bytecomp-tests.el | 24 ++++++++++++++++++++++++
 2 files changed, 34 insertions(+), 2 deletions(-)

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index be74195..a3a3701 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1649,14 +1649,22 @@ URLs."
    (replace-regexp-in-string
     (rx (or
          ;; Ignore some URLs.
-         (seq "http" (? "s") "://" (* anychar))
+         (seq "http" (? "s") "://" (* nonl))
          ;; Ignore these `substitute-command-keys' substitutions.
          (seq "\\" (or "="
                        (seq "<" (* (not ">")) ">")
                        (seq "{" (* (not "}")) "}")))
          ;; Ignore the function signature that's stashed at the end of
          ;; the doc string (in some circumstances).
-         (seq bol "(fn (" (* nonl))))
+         (seq bol "(" (+ (any word "-/:[]&"))
+              ;; One or more arguments.
+              (+ " " (or
+                      ;; Arguments.
+                      (+ (or (syntax symbol)
+                             (any word "-/:[]&=().?^\\#'")))
+                      ;; Argument that is a list.
+                      (seq "(" (* (not ")")) ")")))
+              ")")))
     ""
     ;; Heuristic: assume these substitutions are of some length N.
     (replace-regexp-in-string
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el 
b/test/lisp/emacs-lisp/bytecomp-tests.el
index 2832dd0..a760389 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -1425,6 +1425,30 @@ compiled correctly."
     (load-file (concat file "c"))
     (should (equal (bc-test-alpha-f 'a) '(nil a)))))
 
+(ert-deftest bytecomp-tests-byte-compile--wide-docstring-p/func-arg-list ()
+  (should-not (byte-compile--wide-docstring-p "\
+\(dbus-register-property BUS SERVICE PATH INTERFACE PROPERTY ACCESS \
+[TYPE] VALUE &optional EMITS-SIGNAL DONT-REGISTER-SERVICE)" fill-column))
+  (should-not (byte-compile--wide-docstring-p "\
+(fn CMD FLAGS FIS &key (BUF (cvs-temp-buffer)) DONT-CHANGE-DISC CVSARGS \
+POSTPROC)" fill-column))
+  ;; Bug#49007
+  (should-not (byte-compile--wide-docstring-p "\
+(fn (THIS rudel-protocol-backend) TRANSPORT \
+INFO INFO-CALLBACK &optional PROGRESS-CALLBACK)" fill-column))
+  (should-not (byte-compile--wide-docstring-p "\
+\(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] \
+[:tags \\='(TAG...)] BODY...)" fill-column))
+  (should-not (byte-compile--wide-docstring-p "\
+(make-soap-xs-element &key NAME NAMESPACE-TAG ID TYPE^ OPTIONAL\? MULTIPLE\? \
+REFERENCE SUBSTITUTION-GROUP ALTERNATIVES IS-GROUP)" fill-column))
+  (should-not (byte-compile--wide-docstring-p "\
+(fn NAME FIXTURE INPUT &key SKIP-PAIR-STRING EXPECTED-STRING \
+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)))
+
+
 ;; Local Variables:
 ;; no-byte-compile: t
 ;; End: