From: Harald Jörg <haj@posteo.de>
Date: Thu, 18 Mar 2021 07:06:13 +0000 (+0100)
Subject: cperl-mode: Don't interpret y_ as start of y// function.
X-Git-Tag: emacs-28.0.90~3239
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=261d0f8f74961859d3f801ed7c5205e3eeb80e31;p=emacs.git

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 cc7614dd107..7612f8d284a 100644
--- 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 61e4ece49b7..f0e15022d03 100644
--- 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