From 3c44d7a1b70a2f7c813c9034bb3e28932a1a66c9 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Harald=20J=C3=B6rg?= Date: Wed, 2 Aug 2023 23:53:42 +0200 Subject: [PATCH] cperl-mode.el: Subroutine names are fontified correctly in all places Subroutine names are fontified as subroutine names even if the name is also the name of a builtin (fixing an ancient unreported bug). Subroutine name are just comments in comment and pod (fixing a bug introduced recently) * lisp/progmodes/cperl-mode.el (cperl-init-faces): Move fontification of sub declarations before that of builtins. Don't override existing faces when fontifying subroutine declarations. Don't fontify method calls even if the sub names match those of builtins. * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-fontify-sub-names): New tests with a subroutine name in several surroundings. * test/lisp/progmodes/cperl-mode-resources/sub-names.pl: New resource for the new test. --- lisp/progmodes/cperl-mode.el | 114 ++++++++++-------- .../cperl-mode-resources/sub-names.pl | 25 ++++ test/lisp/progmodes/cperl-mode-tests.el | 33 +++++ 3 files changed, 121 insertions(+), 51 deletions(-) create mode 100644 test/lisp/progmodes/cperl-mode-resources/sub-names.pl diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 5dc49e4ebb4..51bed91c8c2 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -5875,6 +5875,13 @@ default function." cperl-here-face) (t (funcall (default-value 'font-lock-syntactic-face-function) state)))) +(defface cperl-method-call + '((t (:inherit 'default ))) + "The face for method calls. Usually, they are not fontified. +We use this face to prevent calls to methods which look like +builtin functions to be fontified like, well, builtin +functions (which they are not). Inherits from `default'.") + (defun cperl-init-faces () (condition-case errs (progn @@ -5885,8 +5892,59 @@ default function." ;; -------- trailing spaces -> use invalid-face as a warning ;; (matcher subexp facespec) `("[ \t]+$" 0 ',cperl-invalid-face t) + ;; -------- function definition _and_ declaration + ;; (matcher (subexp facespec)) + ;; facespec is evaluated depending on whether the + ;; statement ends in a "{" (definition) or ";" + ;; (declaration without body) + (list (concat "\\<" cperl-sub-regexp + ;; group 1: optional subroutine name + (rx + (sequence (eval cperl--ws+-rx) + (group (optional + (eval cperl--normal-identifier-rx))))) + ;; "fontified" elsewhere: Prototype + (rx (optional + (sequence (eval cperl--ws*-rx) + (eval cperl--prototype-rx)))) + ;; fontified elsewhere: Attributes + (rx (optional (sequence (eval cperl--ws*-rx) + (eval cperl--attribute-list-rx)))) + (rx (eval cperl--ws*-rx)) + ;; group 2: Identifies the start of the anchor + (rx (group + (or (group-n 3 ";") ; Either a declaration... + "{" ; ... or a code block + ;; ... or a complete signature + (sequence (eval cperl--signature-rx) + (eval cperl--ws*-rx)) + ;; ... or the start of a "sloppy" signature + (sequence (eval cperl--sloppy-signature-rx) + ;; arbtrarily continue "a few lines" + (repeat 0 200 (not (in "{")))) + ;; make sure we have a reasonably + ;; short match for an incomplete sub + (not (in ";{(")) + buffer-end)))) + '(1 (if (match-beginning 3) + 'font-lock-variable-name-face + 'font-lock-function-name-face) + nil ; override + t) ; laxmatch in case of anonymous subroutines + ;; -------- anchored: Signature + `(,(rx (sequence (in "(,") + (eval cperl--ws*-rx) + (group (eval cperl--basic-variable-rx)))) + (progn + (goto-char (match-beginning 2)) ; pre-match: Back to sig + (match-end 2)) + nil + (1 font-lock-variable-name-face))) ;; -------- flow control ;; (matcher . subexp) font-lock-keyword-face by default + ;; This highlights declarations and definitions differently. + ;; We do not try to highlight in the case of attributes: + ;; it is already done by `cperl-find-pods-heres' (cons (concat "\\(^\\|[^$@%&\\]\\)\\<\\(" @@ -5910,6 +5968,11 @@ default function." "\\)\\>") 2) ; was "\\)[ \n\t;():,|&]" ; In what follows we use `type' style ; for overwritable builtins + ;; -------- avoid method calls being fontified as keywords + ;; (matcher (subexp facespec)) + (list + (rx "->" (* space) (group-n 1(eval cperl--basic-identifier-rx))) + 1 ''cperl-method-call) ;; -------- builtin functions ;; (matcher subexp facespec) (list @@ -5982,57 +6045,6 @@ default function." ;; (matcher subexp facespec) '("-[rwxoRWXOezsfdlpSbctugkTBMAC]\\>\\([ \t]+_\\>\\)?" 0 font-lock-function-name-face keep) ; Not very good, triggers at "[a-z]" - ;; This highlights declarations and definitions differently. - ;; We do not try to highlight in the case of attributes: - ;; it is already done by `cperl-find-pods-heres' - ;; -------- function definition _and_ declaration - ;; (matcher (subexp facespec)) - ;; facespec is evaluated depending on whether the - ;; statement ends in a "{" (definition) or ";" - ;; (declaration without body) - (list (concat "\\<" cperl-sub-regexp - ;; group 1: optional subroutine name - (rx - (sequence (eval cperl--ws+-rx) - (group (optional - (eval cperl--normal-identifier-rx))))) - ;; "fontified" elsewhere: Prototype - (rx (optional - (sequence (eval cperl--ws*-rx) - (eval cperl--prototype-rx)))) - ;; fontified elsewhere: Attributes - (rx (optional (sequence (eval cperl--ws*-rx) - (eval cperl--attribute-list-rx)))) - (rx (eval cperl--ws*-rx)) - ;; group 2: Identifies the start of the anchor - (rx (group - (or (group-n 3 ";") ; Either a declaration... - "{" ; ... or a code block - ;; ... or a complete signature - (sequence (eval cperl--signature-rx) - (eval cperl--ws*-rx)) - ;; ... or the start of a "sloppy" signature - (sequence (eval cperl--sloppy-signature-rx) - ;; arbtrarily continue "a few lines" - (repeat 0 200 (not (in "{")))) - ;; make sure we have a reasonably - ;; short match for an incomplete sub - (not (in ";{(")) - buffer-end)))) - '(1 (if (match-beginning 3) - 'font-lock-variable-name-face - 'font-lock-function-name-face) - t ;; override - t) ;; laxmatch in case of anonymous subroutines - ;; -------- anchored: Signature - `(,(rx (sequence (in "(,") - (eval cperl--ws*-rx) - (group (eval cperl--basic-variable-rx)))) - (progn - (goto-char (match-beginning 2)) ; pre-match: Back to sig - (match-end 2)) - nil - (1 font-lock-variable-name-face))) ;; -------- various stuff calling for a package name ;; (matcher (subexp facespec) (subexp facespec)) `(,(rx (sequence diff --git a/test/lisp/progmodes/cperl-mode-resources/sub-names.pl b/test/lisp/progmodes/cperl-mode-resources/sub-names.pl new file mode 100644 index 00000000000..46d05b4dbd2 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/sub-names.pl @@ -0,0 +1,25 @@ +use 5.038; +use feature 'class'; +use warnings; +no warnings 'experimental'; + +class C { + # "method" is not yet understood by perl-mode, but it isn't + # relevant here: We can use "sub" because what matters is the + # name, which collides with a builtin. + sub m { + "m called" + } +} + +say C->new->m; + +# 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. + +__END__ + +=head1 Test using the keywords POD + +This piece of POD has a method name in it, and we don't want "method" +to be fontified as a keyword, nor "name" fontified as a name. diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index eaf228cb2e2..8f334245c64 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -256,6 +256,39 @@ These can occur as \"local\" aliases." (should (equal (get-text-property (point) 'face) 'font-lock-variable-name-face)))) +(ert-deftest cperl-test-fontify-sub-names () + "Test fontification of subroutines named like builtins. +On declaration, they should look like other used defined +functions. When called, they should not be fontified. In +comments and POD they should be fontified as POD." + (let ((file (ert-resource-file "sub-names.pl"))) + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (funcall cperl-test-mode) + (font-lock-ensure) + ;; The declaration + (search-forward-regexp "sub \\(m\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + 'font-lock-function-name-face)) + ;; calling as a method + (search-forward-regexp "C->new->\\(m\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + (if (equal cperl-test-mode 'perl-mode) nil + 'cperl-method-call))) + ;; POD + (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 + (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))))) + (ert-deftest cperl-test-identify-heredoc () "Test whether a construct containing \"<<\" followed by a bareword is properly identified for a here-document if -- 2.39.2