mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-22 07:09:54 +00:00
; 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.
This commit is contained in:
Harald Jörg
parent
156392fee5
commit
fc1f6688a2
@ -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_]\\)\\|\\(/\\)\\)"
|
||||
|
||||
62
test/lisp/progmodes/cperl-mode-resources/cperl-bug-66145.pl
Normal file
62
test/lisp/progmodes/cperl-mode-resources/cperl-bug-66145.pl
Normal file
@ -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 = <<DONE;
|
||||
$array_here[$index_here] = $hash_here{key_here};
|
||||
@array_here = qw(in a hrere-document);
|
||||
%hash_here = key_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
|
||||
@ -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")))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user