Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-06-14 12:31:25 +00:00
Code Issues Projects Releases Packages Wiki Activity

;cperl-mode.el: Fix fontification edge cases

Browse source 
These were reported by happy-barney on GitHub
https://github.com/HaraldJoerg/cperl-mode/issues

* lisp/progmodes/cperl-mode.el (cperl-init-faces): Don't mistake
$method as a method declaration.
Move matcher for "use require" higher to prevent "require" being
fontified as keyword.

* test/lisp/progmodes/cperl-mode-resources/sub-names.pl: Add a
test case for $method

* test/lisp/progmodes/cperl-mode-tests.el
(cperl-test-fontify-declarations): Add a test case for a module
name looking like a keyword
(cperl-test-fontify-sub-names): Verify that $method does not
declare a method
This commit is contained in:
Harald Jörg 2026-05-25 11:23:34 +02:00
parent 6d15d68e1f
commit 217064e9dc
3 changed files with 45 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -6353,7 +6353,7 @@ functions (which they are not). Inherits from `default'.")
;; facespec is evaluated depending on whether the
;; statement ends in a "{" (definition) or ";"
;; (declaration without body)
(list (concat "\\<" cperl-sub-regexp
(list (concat "\\(?:\\`\\|[^$%@*&]\\)" cperl-sub-regexp
;; group 1: optional subroutine name
(rx
(sequence (eval cperl--ws+-rx)
@ -6400,6 +6400,23 @@ functions (which they are not). Inherits from `default'.")
(error (match-end 2))))
nil
(1 font-lock-variable-name-face)))
;; -------- various stuff calling for a package name
;; (matcher (subexp facespec) (subexp facespec))
`(,(rx (sequence
(or (sequence (or line-start space "{" )
(group-n 1 (or "package" "require" "use"
"import" "no" "bootstrap" "class"))
(eval cperl--ws+-rx))
(sequence (group-n 2 (sequence ":"
(eval cperl--ws*-rx)
"isa"))
"("
(eval cperl--ws*-rx)))
(group-n 3 (eval cperl--normal-identifier-rx))
(any " \t\n;)"))) ; require A if B;
(1 font-lock-keyword-face t t)
(2 font-lock-constant-face t t)
(3 font-lock-function-name-face))
;; -------- flow control
;; (matcher . subexp) font-lock-keyword-face by default
;; This highlights declarations and definitions differently.
@ -6507,22 +6524,6 @@ functions (which they are not). Inherits from `default'.")
;; (matcher subexp facespec)
'("-[rwxoRWXOezsfdlpSbctugkTBMAC]\\>\\([ \t]+_\\>\\)?" 0
font-lock-function-name-face keep) ; Not very good, triggers at "[a-z]"
;; -------- various stuff calling for a package name
;; (matcher (subexp facespec) (subexp facespec))
`(,(rx (sequence
(or (sequence (or line-start space "{" )
(or "package" "require" "use" "import"
"no" "bootstrap" "class")
(eval cperl--ws+-rx))
(sequence (group-n 2 (sequence ":"
(eval cperl--ws*-rx)
"isa"))
"("
(eval cperl--ws*-rx)))
(group-n 1 (eval cperl--normal-identifier-rx))
(any " \t\n;)"))) ; require A if B;
(1 font-lock-function-name-face)
(2 font-lock-constant-face t t))
;; -------- formats
;; (matcher subexp facespec)
'("^[ \t]*format[ \t]+\\([a-zA-Z_][a-zA-Z_0-9:]*\\)[ \t]*=[ \t]*$"

9
test/lisp/progmodes/cperl-mode-resources/sub-names.pl
View file

@ -17,6 +17,15 @@
# This comment has a method name in it, and we don't want "method"
# to be fontified as a keyword, nor "name" fontified as a name.
# Next is a variable named "$method" followed by a keyword. This
# keyword is not a subroutine name and should not be fontified
# accordingly. Reported by Branislav Zahradnik,
# https://github.com/HaraldJoerg/cperl-mode/issues/24
push @abstract, $method
unless defined &$method
;
__END__
=head1 Test using the keywords POD

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

@ -143,7 +143,8 @@ point in the distant past, and is still broken in perl-mode. "
(with-temp-buffer
(funcall cperl-test-mode)
(insert "package Foo::Bar;\n")
(insert "use Fee::Fie::Foe::Foo\n;")
(insert "use Fee::Fie::Foe::Foo\n;\n")
(insert "use require::relative;\n") ; module name has a keyword
(insert "my $xyzzy = 'PLUGH';\n")
(goto-char (point-min))
(font-lock-ensure)
@ -153,9 +154,15 @@ point in the distant past, and is still broken in perl-mode. "
(search-forward "use") ; This was buggy in perl-mode
(should (equal (get-text-property (match-beginning 0) 'face)
'font-lock-keyword-face))
(search-forward "my")
(should (equal (get-text-property (match-beginning 0) 'face)
'font-lock-keyword-face))))
(re-search-forward (rx(sequence(group-n 1 "use")
(1+ blank)
(group-n 2 "require"))))
(should (equal (get-text-property (match-beginning 1) 'face)
'font-lock-keyword-face))
(should (equal (get-text-property (match-beginning 2) 'face)
(if (eq cperl-test-mode #'cperl-mode)
'font-lock-function-name-face
'font-lock-constant-face)))))
(ert-deftest cperl-test-fontify-attrs-and-signatures ()
"Test fontification of the various combinations of subroutine
@ -330,13 +337,17 @@ comments and POD they should be fontified as POD."
(should (equal (get-text-property (match-beginning 1) 'face)
(if (equal cperl-test-mode 'perl-mode) nil
'cperl-method-call)))
;; POD
;; comment
(search-forward-regexp "\\(method\\) \\(name\\)")
(should (equal (get-text-property (match-beginning 1) 'face)
'font-lock-comment-face))
(should (equal (get-text-property (match-beginning 2) 'face)
'font-lock-comment-face))
;; comment
;; false positive: $method is not a method
(search-forward-regexp "\\($method\\)\\(?:\n\\|\\s-\\)+\\(unless\\)")
(should (equal (get-text-property (match-beginning 2) 'face)
'font-lock-keyword-face))
;; POD
(search-forward-regexp "\\(method\\) \\(name\\)")
(should (equal (get-text-property (match-beginning 1) 'face)
'font-lock-comment-face))