From: Harald Jörg <haj@posteo.de>
Date: Thu, 13 Jun 2024 12:34:16 +0000 (+0200)
Subject: ;cperl-mode.el: Avoid false positives when parsing new Perl syntax
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=d7fc6b69ddfe58838bc2ed95d9ccccb08d717d12;p=emacs.git

;cperl-mode.el: Avoid false positives when parsing new Perl syntax

* lisp/progmodes/cperl-mode.el (cperl--package-for-imenu-rx)
(cperl--class-for-imenu-rx): avoid false positives when collecting
imenu entries
* lisp/progmodes/cperl-mode.el (cperl-init-faces): avoid false
positives when detecting package names

* test/lisp/progmodes/cperl-mode-tests.el
(cperl-test-imenu-index): Add test verifying that $class_false is
not shown as a class _false

* test/lisp/progmodes/cperl-mode-resources/grammar.pl: Add a line
containing a false positive "$class_false"

(cherry picked from commit 39e3c30b514c21854f7fcc87c3a461bd9e81cbdb)
---

diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 1544dcd8a19..68ad7eda9a7 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -1392,7 +1392,7 @@ Contains three groups for the initial keyword \"package\" or
   (defconst cperl--package-for-imenu-rx
     `(sequence symbol-start
                (group-n 1 "package")
-               ,cperl--ws*-rx
+               ,cperl--ws+-rx
                (group-n 2 ,cperl--normal-identifier-rx)
                (optional (sequence ,cperl--ws+-rx
                                    (regexp ,cperl--version-regexp)))
@@ -1408,9 +1408,9 @@ name, and one for the discovery of a following BLOCK.")
   ;; (e.g. ":isa(Parent)") while packages don't.  We skip over it, but
   ;; like for "package" we capture the following ";" or "{".
   (defconst cperl--class-for-imenu-rx
-    `(sequence symbol-start
+    `(sequence (or space line-start)
                (group-n 1 "class")
-               ,cperl--ws*-rx
+               ,cperl--ws+-rx
                (group-n 2 ,cperl--normal-identifier-rx)
                (optional (sequence ,cperl--ws+-rx
                                    (regexp ,cperl--version-regexp)))
@@ -6395,7 +6395,7 @@ functions (which they are not).  Inherits from `default'.")
             ;; -------- various stuff calling for a package name
             ;; (matcher (subexp facespec) (subexp facespec))
             `(,(rx (sequence
-                    (or (sequence symbol-start
+                    (or (sequence (or line-start space "{" )
                                   (or "package" "require" "use" "import"
                                       "no" "bootstrap" "class")
                                   (eval cperl--ws+-rx))
diff --git a/test/lisp/progmodes/cperl-mode-resources/grammar.pl b/test/lisp/progmodes/cperl-mode-resources/grammar.pl
index 14da28b0fd8..b4d2d7c68e3 100644
--- a/test/lisp/progmodes/cperl-mode-resources/grammar.pl
+++ b/test/lisp/progmodes/cperl-mode-resources/grammar.pl
@@ -192,6 +192,9 @@ class Class::Class 0.01 {
     method init_again (@with_parameters) {
 	...;
     }
+
+    # A false positive
+    my $class_false;
 }
 
 =head1 Perl 5.40 brings new stuff
diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el
index 7c8cc3931bc..c91253cbeba 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -977,7 +977,8 @@ created by CPerl mode, so skip it for Perl mode."
                         "With::Readers::auto_reader"
                         "With::Readers::named")))
         (dolist (sub expected)
-          (should (assoc-string sub index)))))))
+          (should (assoc-string sub index))))
+      (should-not (assoc-string "_false" index)))))
 
 ;;; Tests for issues reported in the Bug Tracker