procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
* 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.
This commit is contained in:
Harald Jörg 2025-01-13 12:24:40 +01:00
parent d66b8d4bec
commit b74ac4af94
2 changed files with 19 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
lisp/progmodes/cperl-mode.el
View file

@ -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))

3
test/lisp/progmodes/cperl-mode-tests.el
View file

@ -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