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 (optional
(sequence (sequence
(0+ (sequence ,cperl--ws*-rx (0+ (sequence ,cperl--ws*-rx
,cperl--basic-scalar-rx (or ,cperl--basic-scalar-rx "$")
,cperl--ws*-rx ,cperl--ws*-rx
",")) ","))
,cperl--ws*-rx ,cperl--ws*-rx
(or ,cperl--basic-scalar-rx (or ,cperl--basic-scalar-rx
,cperl--basic-array-rx ,cperl--basic-array-rx
,cperl--basic-hash-rx))) ,cperl--basic-hash-rx
"$" "%" "@")))
(optional (sequence ,cperl--ws*-rx) "," ) (optional (sequence ,cperl--ws*-rx) "," )
,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 (opt (group (eval cperl--normal-identifier-rx))) ; #13
(eval cperl--ws*-rx) (eval cperl--ws*-rx)
(group (or (group (eval cperl--prototype-rx)) ; #14,#15 (group (or (group (eval cperl--prototype-rx)) ; #14,#15
;; (group (eval cperl--signature-rx)) ; #16 (group (eval cperl--signature-rx)) ; #16
(group unmatchable) ; #16 ;; (group unmatchable) ; #16
(group (or anything buffer-end)))))) ; #17 (group (or anything buffer-end)))))) ; #17
"\\|" "\\|"
;; -------- weird variables, capture group 18 ;; -------- 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 13: Name of the subroutine (optional)
;; match-string 14: Indicator for proto/attr/signature ;; match-string 14: Indicator for proto/attr/signature
;; match-string 15: Prototype ;; match-string 15: Prototype
;; match-string 16: unused ;; match-string 16: Subroutine signature
;; match-string 17: Distinguish declaration/definition ;; match-string 17: Distinguish declaration/definition
(setq b1 (match-beginning 13) e1 (match-end 13)) (setq b1 (match-beginning 13) e1 (match-end 13))
(if (memq (char-after (1- b)) (if (memq (char-after (1- b))
@ -5267,9 +5268,18 @@ recursive calls in starting lines of here-documents."
(forward-comment (buffer-size)) (forward-comment (buffer-size))
(cperl-find-sub-attrs st-l b1 e1 b)) (cperl-find-sub-attrs st-l b1 e1 b))
;; treat attributes without prototype and incomplete stuff ;; treat attributes without prototype and incomplete stuff
(goto-char (match-beginning 17)) (if (match-beginning 16) ; a complete subroutine signature
(cperl-find-sub-attrs st-l b1 e1 b)))) ;; A signature ending in "$)" must not be
;; 1+6+2+1+1+6+1=18 extra () before this: ;; 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_]*'") ;; "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'")
((match-beginning 19) ; old $abc'efg syntax ((match-beginning 19) ; old $abc'efg syntax
(setq bb (match-end 0)) (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." "Test subroutine signatures."
(skip-unless (eq cperl-test-mode #'cperl-mode)) (skip-unless (eq cperl-test-mode #'cperl-mode))
(let ((valid (let ((valid
'("()" "( )" "($self, %params)" "(@params)")) '("()" "( )" "($self, %params)" "(@params)" "($first,$)"))
(invalid (invalid
'("$self" ; missing paren '("$self" ; missing paren
"($)" ; a subroutine signature
"($!)" ; globals not permitted in a signature "($!)" ; globals not permitted in a signature
"(@par,%options)" ; two slurpy parameters "(@par,%options)" ; two slurpy parameters
"{$self}"))) ; wrong type of paren "{$self}"))) ; wrong type of paren