;; (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
(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 "@" "$#"))
;; ("\\(%\\)\\(\\$+\\([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_]\\)\\|\\(/\\)\\)"
--- /dev/null
+# 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
(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")))
projects / emacs.git / commitdiff