; cperl-mode.el: Allow bare $ in a signature (Bug#74245)

* lisp/progmodes/cperl-mode.el (cperl--signature-rx): Allow bare
sigils for unused parameters in signatures.
(cperl-find-pods-heres): Avoid $) at the end of a signature being
treated as the punctuation variable $) by treating this dollar as
punctuation

* test/lisp/progmodes/cperl-mode-tests.el
(cperl-test-signature-rx): Add ($first,$) as a valid signature,
remove ($) from the list of invalid signatures.

(cherry picked from commit b74ac4af9408230645f1edb56c410b7a80bb41d2)

diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index c09ab5ddd1fdc1fc920f1f998580e53ef0236b75..ac4088fa8294b327a9ffec0bbdaa2b91aee20c48 100644 (file)
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -1375,13 +1375,14 @@ prototypes from signatures.")
                (optional
                 (sequence
                  (0+ (sequence ,cperl--ws*-rx
-                               ,cperl--basic-scalar-rx
+                               (or ,cperl--basic-scalar-rx "$")
                                ,cperl--ws*-rx
                                ","))
                  ,cperl--ws*-rx
                  (or ,cperl--basic-scalar-rx
                      ,cperl--basic-array-rx
-                     ,cperl--basic-hash-rx)))
+                     ,cperl--basic-hash-rx
+                     "$" "%" "@")))
                (optional (sequence ,cperl--ws*-rx) "," )
                ,cperl--ws*-rx
                ")")
@@ -4413,8 +4414,8 @@ recursive calls in starting lines of here-documents."
                      (opt (group (eval cperl--normal-identifier-rx))) ; #13
                      (eval cperl--ws*-rx)
                      (group (or (group (eval cperl--prototype-rx))    ; #14,#15
-                                ;; (group (eval cperl--signature-rx))    ; #16
-                                (group unmatchable) ; #16
+                                (group (eval cperl--signature-rx))    ; #16
+                                ;; (group unmatchable) ; #16
                                 (group (or anything buffer-end)))))) ; #17
                "\\|"
                 ;; -------- weird variables, capture group 18
@@ -5309,7 +5310,7 @@ recursive calls in starting lines of here-documents."
                ;; match-string 13: Name of the subroutine (optional)
                 ;; match-string 14: Indicator for proto/attr/signature
                 ;; match-string 15: Prototype
-                ;; match-string 16: unused
+                ;; match-string 16: Subroutine signature
                 ;; match-string 17: Distinguish declaration/definition
                 (setq b1 (match-beginning 13) e1 (match-end 13))
                (if (memq (char-after (1- b))
@@ -5325,9 +5326,18 @@ recursive calls in starting lines of here-documents."
                        (forward-comment (buffer-size))
                        (cperl-find-sub-attrs st-l b1 e1 b))
                    ;; treat attributes without prototype and incomplete stuff
-                   (goto-char (match-beginning 17))
-                   (cperl-find-sub-attrs st-l b1 e1 b))))
-              ;; 1+6+2+1+1+6+1=18 extra () before this:
+                    (if (match-beginning 16) ; a complete subroutine signature
+                        ;; A signature ending in "$)" must not be
+                        ;; mistaken as the punctuation variable $) which
+                        ;; messes up balance of parens (Bug#74245).
+                        (progn
+                          (when (= (char-after (- (match-end 16) 2)) ?$)
+                            (put-text-property (- (match-end 16) 2) (1- (match-end 16))
+                                               'syntax-table cperl-st-punct))
+                          (goto-char (match-end 16)))
+                     (goto-char (match-beginning 17))
+                     (cperl-find-sub-attrs st-l b1 e1 b)))))
+               ;; 1+6+2+1+1+6+1=18 extra () before this:
               ;;    "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'")
               ((match-beginning 19)    ; old $abc'efg syntax
                (setq bb (match-end 0))

diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el
index 0d8bdb8c419560074d2f758beb99fcc762b3695c..dfa1f91e00a1f1d9b0fca738c9a54639ae21fad9 100644 (file)
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -622,10 +622,9 @@ Also includes valid cases with whitespace in strange places."
    "Test subroutine signatures."
    (skip-unless (eq cperl-test-mode #'cperl-mode))
    (let ((valid
-          '("()" "( )" "($self, %params)" "(@params)"))
+          '("()" "( )" "($self, %params)" "(@params)" "($first,$)"))
         (invalid
          '("$self"               ; missing paren
-           "($)"                 ; a subroutine signature
            "($!)"                ; globals not permitted in a signature
            "(@par,%options)"     ; two slurpy parameters
            "{$self}")))          ; wrong type of paren