From b74ac4af9408230645f1edb56c410b7a80bb41d2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Harald=20J=C3=B6rg?= <haj@posteo.de>
Date: Mon, 13 Jan 2025 12:24:40 +0100
Subject: [PATCH] ; 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