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

[Harald Jörg]

branch: emacs-30
commit b74ac4af9408230645f1edb56c410b7a80bb41d2
Author: Harald Jörg <haj@posteo.de>
Commit: Harald Jörg <haj@posteo.de>

    ; 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.
---
 lisp/progmodes/cperl-mode.el            | 26 ++++++++++++++++++--------
 test/lisp/progmodes/cperl-mode-tests.el |  3 +--
 2 files changed, 19 insertions(+), 10 deletions(-)

diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index ed8527f0039..38015ed2acd 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -1352,13 +1352,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
                ")")
@@ -4355,8 +4356,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
@@ -5251,7 +5252,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))
@@ -5267,9 +5268,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 1f3c0ca3213..958ffe38a8b 100644
--- 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