cperl-mode: Don't interpret y_ as start of y// function.

* lisp/progmodes/cperl-mode.el (cperl-find-pods-heres): Avoid
treating underscores as word-terminators.

* test/lisp/progmodes/cperl-mode-tests.el
(cperl-test-bug-47112): Test case for that bug (bug#47112).
This commit is contained in:
Harald Jörg 2021-03-18 08:06:13 +01:00 committed by Lars Ingebrigtsen
parent 846e8672bb
commit 261d0f8f74
2 changed files with 44 additions and 15 deletions

View file

@ -3927,21 +3927,24 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
bb (char-after (1- (match-beginning b1))) ; tmp holder
;; bb == "Not a stringy"
bb (if (eq b1 10) ; user variables/whatever
(and (memq bb (append "$@%*#_:-&>" nil)) ; $#y)
(cond ((eq bb ?-) (eq c ?s)) ; -s file test
((eq bb ?\:) ; $opt::s
(eq (char-after
(- (match-beginning b1) 2))
?\:))
((eq bb ?\>) ; $foo->s
(eq (char-after
(- (match-beginning b1) 2))
?\-))
((eq bb ?\&)
(not (eq (char-after ; &&m/blah/
(- (match-beginning b1) 2))
?\&)))
(t t)))
(or
; false positive: "y_" has no word boundary
(save-match-data (looking-at "_"))
(and (memq bb (append "$@%*#_:-&>" nil)) ; $#y)
(cond ((eq bb ?-) (eq c ?s)) ; -s file test
((eq bb ?\:) ; $opt::s
(eq (char-after
(- (match-beginning b1) 2))
?\:))
((eq bb ?\>) ; $foo->s
(eq (char-after
(- (match-beginning b1) 2))
?\-))
((eq bb ?\&)
(not (eq (char-after ; &&m/blah/
(- (match-beginning b1) 2))
?\&)))
(t t))))
;; <file> or <$file>
(and (eq c ?\<)
;; Do not stringify <FH>, <$fh> :

View file

@ -447,4 +447,30 @@ have a face property."
;; The yadda-yadda operator should not be in a string.
(should (equal (nth 8 (cperl-test-ppss code "\\.")) nil))))
(ert-deftest cperl-test-bug-47112 ()
"Check that in a bareword starting with a quote-like operator
followed by an underscore is not interpreted as that quote-like
operator. Also check that a quote-like operator followed by a
colon (which is, like ?_, a symbol in CPerl mode) _is_ identified
as that quote like operator."
(with-temp-buffer
(funcall cperl-test-mode)
(insert "sub y_max { q:bar:; y _bar_foo_; }")
(goto-char (point-min))
(cperl-update-syntaxification (point-max))
(font-lock-fontify-buffer)
(search-forward "max")
(should (equal (get-text-property (match-beginning 0) 'face)
'font-lock-function-name-face))
(search-forward "bar")
(should (equal (get-text-property (match-beginning 0) 'face)
'font-lock-string-face))
; perl-mode doesn't highlight
(when (eq cperl-test-mode #'cperl-mode)
(search-forward "_")
(should (equal (get-text-property (match-beginning 0) 'face)
(if (eq cperl-test-mode #'cperl-mode)
'font-lock-constant-face
font-lock-string-face))))))
;;; cperl-mode-tests.el ends here