; 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.

diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 809a7274a2526c296dc397e4962d79838fcc6f2c..c0e9cfde8e75d87ad1cbe14366ef95ca1d481f73 100644 (file)
--- 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 211587cabacf6fd5fe0a3bc3db4dcba3300fbc58..eaf228cb2e25143091cbb2d58e170f7054ff11a3 100644 (file)
--- 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)))