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).

diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index cc7614dd107cc004ff0847dbe3c728e7f3f955b7..7612f8d284a18c50de2fa7467873c5f3143ca12f 100644 (file)
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -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> :

diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el
index 61e4ece49b7f0f8a33fc0f527d321e55194b0a1e..f0e15022d0316b5467060ef4340630649780f5c1 100644 (file)
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -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