From 3cea0a84900176bca60586d21c6a556056b4292c Mon Sep 17 00:00:00 2001
From: =?utf8?q?Harald=20J=C3=B6rg?= <haj@posteo.de>
Date: Thu, 6 Jul 2023 17:29:42 +0200
Subject: [PATCH] ; cperl-mode: Refine syntax of attributes
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

Attributes may start with underscore, and must be separated.
Thanks to Mattias Engdegård for pointing out a regex mistake.

* lisp/progmodes/cperl-mode.el (defconst): Fix bad grouping and
allow attributes to start with an underscore in
cperl--single-attribute-rx.  Adjust cperl--attribute-list-rx
accordingly.
(cperl-find-sub-attrs): Allow attributes to start with an underscore.

* test/lisp/progmodes/cperl-mode-tests.el
(cperl-test-attribute-list-rx): Add new test cases for valid and
invalid attribute lists.
---
 lisp/progmodes/cperl-mode.el            | 34 ++++++++++++++++---------
 test/lisp/progmodes/cperl-mode-tests.el |  8 ++++--
 2 files changed, 28 insertions(+), 14 deletions(-)

diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 809a7274a25..c0e9cfde8e7 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -1305,23 +1305,33 @@ or \"${ foo }\" will not.")
     "A sequence for recommended version number schemes in Perl.")
 
   (defconst cperl--single-attribute-rx
-    `(sequence word-start
-               ,cperl--basic-identifier-rx
+    `(sequence ,cperl--basic-identifier-rx
                (optional (sequence "("
-                          (0+ (not (in ")")))
-                          ")")))
+                                   (0+ (or (sequence "\\" not-newline)
+                                           (not (any "()\\"))
+                                           (sequence "("
+		                                     (zero-or-more
+		                                      (not
+		                                       (any "()\\")))
+		                                     ")")))
+                                   ")")))
     "A regular expression for a single attribute, without leading colon.
-It may have parameters in parens, but parens within the
-parameter's value are not supported.  This regexp does not have
+It may have parameters in parens, one level of parens within the
+parameter's value is supported.  This regexp does not have
 capture groups.")
 
   (defconst cperl--attribute-list-rx
     `(sequence ":"
-               (0+ (sequence
-                    ,cperl--ws*-rx
-                    ,cperl--single-attribute-rx
-                    ,cperl--ws*-rx
-                    (optional ":"))))
+               (optional
+                ,cperl--ws*-rx
+                ,cperl--single-attribute-rx
+                (0+ (sequence
+                     (or (sequence ,cperl--ws*-rx
+                                   ":"
+                                   ,cperl--ws*-rx)
+                         ,cperl--ws+-rx)
+                     ,cperl--single-attribute-rx))
+                (optional ":")))
     "A regular expression for an attribute list.
 Attribute lists may only occur in certain declarations.  A colon
 is required before the first attribute but optional between
@@ -3607,7 +3617,7 @@ Should be called with the point before leading colon of an attribute."
 		 "\\)"
 		 (if after-first "?" "")
 		 ;; No space between name and paren allowed...
-		 "\\(\\sw+\\)"		; 3=name
+		 (rx (group (eval cperl--basic-identifier-rx)))	; 3=name
 		 "\\((\\)?"))		; 4=optional paren
 	  (and (match-beginning 1)
 	       (cperl-postpone-fontification
diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el
index 211587cabac..eaf228cb2e2 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -484,12 +484,16 @@ Also includes valid cases with whitespace in strange places."
   (skip-unless (eq cperl-test-mode #'cperl-mode))
   (let ((valid
          '(":" ":foo" ": bar()" ":baz(quux):"
-           ":isa(Foo)does(Bar)" ":isa(Foo):does(Bar)" ":isa(Foo):does(Bar):"
+           ":_" ":_foo"
+           ":isa(Foo) does(Bar)" ":isa(Foo):does(Bar)"
+           ":isa(Foo):does(Bar):"
            ":  isa(Foo::Bar) : does(Bar)"))
         (invalid
          '(":foo + bar"                ; not an identifier
+           "::foo"                     ; not an attribute list
            ": foo(bar : : baz"         ; too many colons
-           ": baz (quux)")))             ; no space allowed before "("
+           ": foo(bar)baz"             ; need a separator
+           ": baz (quux)")))           ; no space allowed before "("
     (cperl-test--validate-regexp (rx (eval cperl--attribute-list-rx))
                                  valid invalid)))
 
-- 
2.39.5