cperl-mode.el: Support Perl 5.38 syntax for subroutine signatures

* lisp/progmodes/cperl-mode.el (defconst): New rx sequence
describing a signature with initialization.
(cperl-init-faces): integrate the new rx sequence into the
font-lock-defaults init routine (Bug#64190) (Bug#64364).

* test/lisp/progmodes/cperl-mode-resources/cperl-bug-64364.pl: Add
test data for a signature with initialization (tests indentation).

* test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl: Add
test data for a signature with initialization (tests fontification).

diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index adfaeee8c976bae074ec8e123e77483861fcf6c1..c1e55944b7efd9bb31378e829d1dbab1e4517b00 100644 (file)
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -1349,11 +1349,22 @@ prototypes from signatures.")
                (optional (sequence ,cperl--ws*-rx) "," )
                ,cperl--ws*-rx
                ")")
-    "A regular expression for a subroutine signature.
+    "A rx sequence subroutine signature without initializers.
 These are a bit more restricted than \"my\" declaration lists
 because they allow only one slurpy variable, and only in the last
 place.")
 
+  (defconst cperl--sloppy-signature-rx
+    `(sequence "("
+               ,cperl--ws*-rx
+               (or ,cperl--basic-scalar-rx
+                   ,cperl--basic-array-rx
+                   ,cperl--basic-hash-rx)
+               ,cperl--ws*-rx
+               (or "," "=" "||=" "//=" ")"))
+    "A rx sequence for the begin of a signature with initializers.
+Initializers can contain almost all Perl constructs and thus can not be covered by regular expressions.  This sequence captures enough to distinguish a signature from a prototype.")
+
   (defconst cperl--package-rx
     `(sequence (group "package")
                ,cperl--ws+-rx
@@ -5920,40 +5931,46 @@ default function."
             ;; statement ends in a "{" (definition) or ";"
             ;; (declaration without body)
            (list (concat "\\<" cperl-sub-regexp
+                          ;; group 1: optional subroutine name
                           (rx
                            (sequence (eval cperl--ws+-rx)
-                                     (group (optional (eval cperl--normal-identifier-rx)))))
-;;                       "\\([^ \n\t{;()]+\\)" ; 2=name (assume non-anonymous)
-                          (rx
-                           (optional
-                            (group (sequence (group (eval cperl--ws*-rx))
-                                             (eval cperl--prototype-rx)))))
-;;                       "\\("
-;;                       cperl-maybe-white-and-comment-rex ;whitespace/comments?
-                          ;;                     "([^()]*)\\)?" ; prototype
+                                     (group (optional
+                                             (eval cperl--normal-identifier-rx)))))
+                          ;; "fontified" elsewhere: Prototype
+                          (rx (optional
+                               (sequence (eval cperl--ws*-rx)
+                                         (eval cperl--prototype-rx))))
+                          ;; fontified elsewhere: Attributes
                           (rx (optional (sequence (eval cperl--ws*-rx)
                                                   (eval cperl--attribute-list-rx))))
-;                        cperl-maybe-white-and-comment-rex ; whitespace/comments?
-                          (rx (group-n 3
-                                (optional (sequence(eval cperl--ws*-rx)
-                                                   (eval cperl--signature-rx)))))
                           (rx (eval cperl--ws*-rx))
-                         "[{;]")
-                 '(1 (if (eq (char-after (cperl-1- (match-end 0))) ?\{ )
-                         'font-lock-function-name-face
-                       'font-lock-variable-name-face)
+                          ;; group 2: Identifies the start of the anchor
+                          (rx (group
+                               (or (group-n 3 ";") ; Either a declaration...
+                                   "{"             ; ... or a code block
+                                   ;; ... or a complete signature
+                                   (sequence (eval cperl--signature-rx)
+                                             (eval cperl--ws*-rx))
+                                   ;; ... or the start of a "sloppy" signature
+                                   (sequence (eval cperl--sloppy-signature-rx)
+                                             ;; arbtrarily continue "a few lines"
+                                             (repeat 0 200 (not (in "{"))))))))
+                 '(1 (if (match-beginning 3)
+                         'font-lock-variable-name-face
+                       'font-lock-function-name-face)
                       t  ;; override
                       t) ;; laxmatch in case of anonymous subroutines
                   ;; -------- anchored: Signature
-                  `(,(rx (or (eval cperl--basic-scalar-rx)
-                             (eval cperl--basic-array-rx)
-                             (eval cperl--basic-hash-rx)))
+                  `(,(rx (sequence (in "(,")
+                                   (eval cperl--ws*-rx)
+                                   (group (or (eval cperl--basic-scalar-rx)
+                                              (eval cperl--basic-array-rx)
+                                              (eval cperl--basic-hash-rx)))))
                     (progn
-                      (goto-char (match-beginning 3)) ; pre-match: Back to sig
-                      (match-end 3))
-
+                      (goto-char (match-beginning 2)) ; pre-match: Back to sig
+                      (match-end 2))
                     nil
-                    (0 font-lock-variable-name-face)))
+                    (1 font-lock-variable-name-face)))
             ;; -------- various stuff calling for a package name
             ;; (matcher subexp facespec)
             `(,(rx (sequence symbol-start

diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-64364.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-64364.pl
index af188cbedac957b83e32d8b22d74a8551c2d9acf..62ef6982f388e5824ed71d4f1757c2c2166fe175 100644 (file)
--- a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-64364.pl
+++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-64364.pl
@@ -24,3 +24,32 @@ package P {
     }
 }
 # -------- Bug#64364: end -------
+
+# Now do this with multiline initializers
+# -------- signature with init: input -------
+package P {
+sub way { ...; }
+# perl 5.38 or newer
+sub bus
+:lvalue
+($sig,
+$na //= 42,
+@ture)
+{
+...;
+}
+}
+# -------- signature with init: expected output -------
+package P {
+    sub way { ...; }
+    # perl 5.38 or newer
+    sub bus
+       :lvalue
+       ($sig,
+        $na //= 42,
+        @ture)
+    {
+       ...;
+    }
+}
+# -------- signature with init: end -------

diff --git a/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl b/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl
index 6ed5c0dfc41789e79a0de77d9fafeef9964988aa..1f89825025234030bc8571b8f051d749dfc32ad5 100644 (file)
--- a/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl
+++ b/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl
@@ -34,9 +34,17 @@ sub sub_4 :prototype($$$) ($foo,$bar,$baz) { ...; }
 # A signature with a trailing comma (weird, but legal)
 sub sub_5 ($foo,$bar,) { ...; }
 
+# Perl 5.38-style initializer
+sub sub_6
+    ($foo,
+     $bar //= "baz")
+{
+}
+
+
 # Part 2: Same constructs for anonymous subs
 # A plain named subroutine without any optional stuff
-my $subref_0 = sub { ...; }
+my $subref_0 = sub { ...; };
 
 # A prototype and a trivial subroutine attribute
 {