>From c68e15dc4bfceb6e084645f987fc401edb87f7d9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Harald=20J=C3=B6rg?= <haj@posteo.de>
Date: Sat, 13 Mar 2021 00:57:30 +0100
Subject: [PATCH] ; 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.
---
 lisp/progmodes/cperl-mode.el            | 33 ++++++++++++++-----------
 test/lisp/progmodes/cperl-mode-tests.el | 26 +++++++++++++++++++
 2 files changed, 44 insertions(+), 15 deletions(-)

diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 734797b3ad..7e7327d986 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -3926,21 +3926,24 @@ cperl-find-pods-heres
 		      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 61e4ece49b..f0e15022d0 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -447,4 +447,30 @@ cperl-test-bug-45255
     ;; 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
-- 
2.20.1