mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-06-14 12:31:25 +00:00
;cperl-mode.el: Fix fontification edge cases
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:
parent
6d15d68e1f
commit
217064e9dc
3 changed files with 45 additions and 24 deletions
|
|
@ -6353,7 +6353,7 @@ functions (which they are not). Inherits from `default'.")
|
||||||
;; facespec is evaluated depending on whether the
|
;; facespec is evaluated depending on whether the
|
||||||
;; statement ends in a "{" (definition) or ";"
|
;; statement ends in a "{" (definition) or ";"
|
||||||
;; (declaration without body)
|
;; (declaration without body)
|
||||||
(list (concat "\\<" cperl-sub-regexp
|
(list (concat "\\(?:\\`\\|[^$%@*&]\\)" cperl-sub-regexp
|
||||||
;; group 1: optional subroutine name
|
;; group 1: optional subroutine name
|
||||||
(rx
|
(rx
|
||||||
(sequence (eval cperl--ws+-rx)
|
(sequence (eval cperl--ws+-rx)
|
||||||
|
|
@ -6400,7 +6400,24 @@ functions (which they are not). Inherits from `default'.")
|
||||||
(error (match-end 2))))
|
(error (match-end 2))))
|
||||||
nil
|
nil
|
||||||
(1 font-lock-variable-name-face)))
|
(1 font-lock-variable-name-face)))
|
||||||
;; -------- flow control
|
;; -------- 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
|
;; (matcher . subexp) font-lock-keyword-face by default
|
||||||
;; This highlights declarations and definitions differently.
|
;; This highlights declarations and definitions differently.
|
||||||
;; We do not try to highlight in the case of attributes:
|
;; We do not try to highlight in the case of attributes:
|
||||||
|
|
@ -6507,22 +6524,6 @@ functions (which they are not). Inherits from `default'.")
|
||||||
;; (matcher subexp facespec)
|
;; (matcher subexp facespec)
|
||||||
'("-[rwxoRWXOezsfdlpSbctugkTBMAC]\\>\\([ \t]+_\\>\\)?" 0
|
'("-[rwxoRWXOezsfdlpSbctugkTBMAC]\\>\\([ \t]+_\\>\\)?" 0
|
||||||
font-lock-function-name-face keep) ; Not very good, triggers at "[a-z]"
|
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
|
;; -------- formats
|
||||||
;; (matcher subexp facespec)
|
;; (matcher subexp facespec)
|
||||||
'("^[ \t]*format[ \t]+\\([a-zA-Z_][a-zA-Z_0-9:]*\\)[ \t]*=[ \t]*$"
|
'("^[ \t]*format[ \t]+\\([a-zA-Z_][a-zA-Z_0-9:]*\\)[ \t]*=[ \t]*$"
|
||||||
|
|
|
||||||
|
|
@ -17,6 +17,15 @@
|
||||||
# This comment has a method name in it, and we don't want "method"
|
# 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.
|
# 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__
|
__END__
|
||||||
|
|
||||||
=head1 Test using the keywords POD
|
=head1 Test using the keywords POD
|
||||||
|
|
|
||||||
|
|
@ -143,7 +143,8 @@ point in the distant past, and is still broken in perl-mode. "
|
||||||
(with-temp-buffer
|
(with-temp-buffer
|
||||||
(funcall cperl-test-mode)
|
(funcall cperl-test-mode)
|
||||||
(insert "package Foo::Bar;\n")
|
(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")
|
(insert "my $xyzzy = 'PLUGH';\n")
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(font-lock-ensure)
|
(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
|
(search-forward "use") ; This was buggy in perl-mode
|
||||||
(should (equal (get-text-property (match-beginning 0) 'face)
|
(should (equal (get-text-property (match-beginning 0) 'face)
|
||||||
'font-lock-keyword-face))
|
'font-lock-keyword-face))
|
||||||
(search-forward "my")
|
(re-search-forward (rx(sequence(group-n 1 "use")
|
||||||
(should (equal (get-text-property (match-beginning 0) 'face)
|
(1+ blank)
|
||||||
'font-lock-keyword-face))))
|
(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 ()
|
(ert-deftest cperl-test-fontify-attrs-and-signatures ()
|
||||||
"Test fontification of the various combinations of subroutine
|
"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)
|
(should (equal (get-text-property (match-beginning 1) 'face)
|
||||||
(if (equal cperl-test-mode 'perl-mode) nil
|
(if (equal cperl-test-mode 'perl-mode) nil
|
||||||
'cperl-method-call)))
|
'cperl-method-call)))
|
||||||
;; POD
|
;; comment
|
||||||
(search-forward-regexp "\\(method\\) \\(name\\)")
|
(search-forward-regexp "\\(method\\) \\(name\\)")
|
||||||
(should (equal (get-text-property (match-beginning 1) 'face)
|
(should (equal (get-text-property (match-beginning 1) 'face)
|
||||||
'font-lock-comment-face))
|
'font-lock-comment-face))
|
||||||
(should (equal (get-text-property (match-beginning 2) 'face)
|
(should (equal (get-text-property (match-beginning 2) 'face)
|
||||||
'font-lock-comment-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\\)")
|
(search-forward-regexp "\\(method\\) \\(name\\)")
|
||||||
(should (equal (get-text-property (match-beginning 1) 'face)
|
(should (equal (get-text-property (match-beginning 1) 'face)
|
||||||
'font-lock-comment-face))
|
'font-lock-comment-face))
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue