From fc1f6688a2d673e6f440700b6b256de2a96d652a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Harald=20J=C3=B6rg?= Date: Mon, 9 Oct 2023 17:49:15 +0200 Subject: [PATCH] ; cperl-mode.el: Don't override fontificaton in comments. * lisp/progmodes/cperl-mode.el (cperl-init-faces): Reorder the matchers for fontification of array and hash elements and keys so that they don't override comment and string fontification (Bug#66145). * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-bug-66145): New test for all combinations of sigils and brackets/braces to verify that strings and comments are left untouched. This test also works for perl-mode which has always done it correctly. * test/lisp/progmodes/cperl-mode-resources/cperl-bug-66145.pl: New resource file for the above test. --- lisp/progmodes/cperl-mode.el | 108 +++++++++--------- .../cperl-mode-resources/cperl-bug-66145.pl | 62 ++++++++++ test/lisp/progmodes/cperl-mode-tests.el | 23 ++++ 3 files changed, 138 insertions(+), 55 deletions(-) create mode 100644 test/lisp/progmodes/cperl-mode-resources/cperl-bug-66145.pl diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 1736b45c72d..c2d9c0d6020 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -6049,35 +6049,6 @@ functions (which they are not). Inherits from `default'.") ;; (matcher subexp facespec) '("^[ \t]*format[ \t]+\\([a-zA-Z_][a-zA-Z_0-9:]*\\)[ \t]*=[ \t]*$" 1 font-lock-function-name-face) - ;; -------- bareword hash key: $foo{bar}, $foo[1]{bar} - ;; (matcher (subexp facespec) ... - `(,(rx (or (in "]}\\%@>*&") - (sequence "$" (eval cperl--normal-identifier-rx))) - (0+ blank) "{" (0+ blank) - (group-n 1 (sequence (opt "-") - (eval cperl--basic-identifier-rx))) - (0+ blank) "}") -;; '("\\([]}\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" - (1 font-lock-string-face t) - ;; -------- anchored bareword hash key: $foo{bar}{baz} - ;; ... (anchored-matcher pre-form post-form subex-highlighters) - (,(rx point - (0+ blank) "{" (0+ blank) - (group-n 1 (sequence (opt "-") - (eval cperl--basic-identifier-rx))) - (0+ blank) "}") - ;; ("\\=[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" - nil nil - (1 font-lock-string-face t))) - ;; -------- hash element assignments with bareword key => value - ;; (matcher subexp facespec) - `(,(rx (in "[ \t{,()") - (group-n 1 (sequence (opt "-") - (eval cperl--basic-identifier-rx))) - (0+ blank) "=>") - 1 font-lock-string-face t) - ;; '("[[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1 - ;; font-lock-string-face t) ;; -------- labels ;; (matcher subexp facespec) `(,(rx @@ -6177,32 +6148,33 @@ functions (which they are not). Inherits from `default'.") (setq t-font-lock-keywords-1 `( - ;; -------- arrays and hashes. Access to elements is fixed below - ;; (matcher subexp facespec) - ;; facespec is an expression to distinguish between arrays and hashes - (,(rx (group-n 1 (group-n 2 (or (in "@%") "$#")) - (eval cperl--normal-identifier-rx))) - 1 -;; ("\\(\\([@%]\\|\\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1 - (if (eq (char-after (match-beginning 2)) ?%) - 'cperl-hash-face - 'cperl-array-face) - nil) - ;; -------- access to array/hash elements - ;; (matcher subexp facespec) - ;; facespec is an expression to distinguish between arrays and hashes - (,(rx (group-n 1 (group-n 2 (in "$@%")) - (eval cperl--normal-identifier-rx)) - (0+ blank) - (group-n 3 (in "[{"))) -;; ("\\(\\([$@%]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)" - 1 - (if (= (- (match-end 2) (match-beginning 2)) 1) - (if (eq (char-after (match-beginning 3)) ?{) - 'cperl-hash-face - 'cperl-array-face) ; arrays and hashes - font-lock-variable-name-face) ; Just to put something - t) ; override previous + ;; -------- bareword hash key: $foo{bar}, $foo[1]{bar} + ;; (matcher (subexp facespec) ... + (,(rx (or (in "]}\\%@>*&") + (sequence "$" (eval cperl--normal-identifier-rx))) + (0+ blank) "{" (0+ blank) + (group-n 1 (sequence (opt "-") + (eval cperl--basic-identifier-rx))) + (0+ blank) "}") +;; '("\\([]}\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" + (1 font-lock-string-face) + ;; -------- anchored bareword hash key: $foo{bar}{baz} + ;; ... (anchored-matcher pre-form post-form subex-highlighters) + (,(rx point + (0+ blank) "{" (0+ blank) + (group-n 1 (sequence (opt "-") + (eval cperl--basic-identifier-rx))) + (0+ blank) "}") + ;; ("\\=[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" + nil nil + (1 font-lock-string-face))) + ;; -------- hash element assignments with bareword key => value + ;; (matcher subexp facespec) + (,(rx (in "[ \t{,()") + (group-n 1 (sequence (opt "-") + (eval cperl--basic-identifier-rx))) + (0+ blank) "=>") + 1 font-lock-string-face) ;; -------- @$ array dereferences, $#$ last array index ;; (matcher (subexp facespec) (subexp facespec)) (,(rx (group-n 1 (or "@" "$#")) @@ -6221,6 +6193,32 @@ functions (which they are not). Inherits from `default'.") ;; ("\\(%\\)\\(\\$+\\([a-zA-Z_:][a-zA-Z0-9_:]*\\|[^ \t\n]\\)\\)" (1 'cperl-hash-face) (2 font-lock-variable-name-face)) + ;; -------- access to array/hash elements + ;; (matcher subexp facespec) + ;; facespec is an expression to distinguish between arrays and hashes + (,(rx (group-n 1 (group-n 2 (in "$@%")) + (eval cperl--normal-identifier-rx)) + (0+ blank) + (group-n 3 (in "[{"))) +;; ("\\(\\([$@%]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)" + 1 + (if (= (- (match-end 2) (match-beginning 2)) 1) + (if (eq (char-after (match-beginning 3)) ?{) + 'cperl-hash-face + 'cperl-array-face) ; arrays and hashes + font-lock-variable-name-face) ; Just to put something + nil) ; do not override previous + ;; -------- "Pure" arrays and hashes. + ;; (matcher subexp facespec) + ;; facespec is an expression to distinguish between arrays and hashes + (,(rx (group-n 1 (group-n 2 (or (in "@%") "$#")) + (eval cperl--normal-identifier-rx))) + 1 +;; ("\\(\\([@%]\\|\\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1 + (if (eq (char-after (match-beginning 2)) ?%) + 'cperl-hash-face + 'cperl-array-face) + nil) ;;("\\([smy]\\|tr\\)\\([^a-z_A-Z0-9]\\)\\(\\([^\n\\]*||\\)\\)\\2") ;;; Too much noise from \s* @s[ and friends ;;("\\(\\<\\([msy]\\|tr\\)[ \t]*\\([^ \t\na-zA-Z0-9_]\\)\\|\\(/\\)\\)" diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-66145.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-66145.pl new file mode 100644 index 00000000000..70f12346ded --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-66145.pl @@ -0,0 +1,62 @@ +# The original code, from the bug report, with variables renamed + +sub foo { + # Here we do something like + # this: $array_comment [ num_things ]->{key_comment} +} + +# -------------------------------------------------- +# Comments containing hash and array sigils + +# This is an @array, and this is a %hash +# $array_comment[$index] = $hash_comment{key_comment} +# The last element has the index $#array_comment +# my @a_slice = @array_comment[1,2,3]; +# my @h_slice = @hash_comment{qw(a b c)}; +# my %a_set = %array_comment[1,2,3]; +# my %h_set = %hash_comment{qw(a b c)}; + +# -------------------------------------------------- +# in POD + +=head1 NAME + +cperl-bug-66145 - don't fontify arrays and hashes in POD + +=head1 SYNOPSIS + + $array_comment[$index] = $hash_comment{key_comment}; + @array_comment = qw(in pod); + %hash_comment = key_comment => q(pod); + @array_comment = @array_comment[1,2,3]; + @array_comment = @hash_comment{qw(a b c)}; + %hash_comment = %array_comment[1,2,3]; + %hash_comment = %hash_comment{qw(a b c)}; + +=cut + +# -------------------------------------------------- +# in strings + +my @strings = ( + q/$array_string[$index] = $hash_string{key_string};/, + q/my @array_string = qw(in unquoted string);/, + q/my %hash_string = (key_string => q(pod);)/, + q/@array_string = @array_string[1,2,3];/, + q/@array_string = @hash_string{qw(a b c)};/, + q/%hash_string = %array_string[1,2,3];/, + q/%hash_string = %hash_string{qw(a b c)};/, +); + +# -------------------------------------------------- +# in a HERE-document (perl-mode has an extra face for that) + +my $here = < q(pod); + @array_here = @array_here[1,2,3]; + @array_here = @hash_here{qw(a b c)}; + %hash_here = %array_here[1,2,3]; + %hash_here = %hash_here{qw(a b c)}; +DONE diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index a29ee54b6b9..87d4f11280c 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -1379,6 +1379,29 @@ as a regex." (forward-line 1)))) (cperl-set-style-back)) +(ert-deftest cperl-test-bug-66145 () + "Verify that hashes and arrays are only fontified in code. +In strings, comments and POD the syntaxified faces should +prevail. The tests exercise all combinations of sigils $@% and +parenthesess [{ for comments, POD, strings and HERE-documents. +Fontification in code for `cperl-mode' is done in the tests +beginning with `cperl-test-unicode`." + (let ((types '("array" "hash" "key")) + (faces `(("string" . font-lock-string-face) + ("comment" . font-lock-comment-face) + ("here" . ,(if (equal cperl-test-mode 'perl-mode) + 'perl-heredoc + font-lock-string-face))))) + (with-temp-buffer + (insert-file-contents (ert-resource-file "cperl-bug-66145.pl")) + (funcall cperl-test-mode) + (font-lock-ensure) + (dolist (type types) + (goto-char (point-min)) + (while (re-search-forward (concat type "_\\([a-z]+\\)") nil t) + (should (equal (get-text-property (match-beginning 1) 'face) + (cdr (assoc (match-string-no-properties 1) + faces))))))))) (ert-deftest test-indentation () (ert-test-erts-file (ert-resource-file "cperl-indents.erts")))