; cperl-mode: Refine syntax of attributes

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

@@ -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

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