Only allow punct delimiter for regex subpattern

The experimental feature that allows wildcard subpatterns in finding
Unicode properties, is supposed to only allow ASCII punctuation for
delimitters.  But if you preceded the delimitter by a backslash, the
check was skipped.  This commit fixes that.

It may be that we will eventually want to loosen the restriction and
allow a wider range of delimiters.  But until we have valid use-cases
that would push us in that direction, I don't want to get into
supporting stuff that we might later regret, such as invisible
characters for delimitters.  This feature is not really required for
programs to work, so I don't view it as necessary to be as general as
possible.

diff --git a/regcomp.c b/regcomp.c
index 6aa9c62..129d692 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -23290,10 +23290,13 @@ Perl_parse_uniprop_string(pTHX_
         /* Most punctuation after the equals indicates a subpattern, like
          * \p{foo=/bar/} */
         if (   isPUNCT_A(name[i])
-            && name[i] != '-'
-            && name[i] != '+'
-            && name[i] != '_'
-            && name[i] != '{')
+            &&  name[i] != '-'
+            &&  name[i] != '+'
+            &&  name[i] != '_'
+            &&  name[i] != '{'
+                /* A backslash means the real delimitter is the next character,
+                 * but it must be punctuation */
+            && (name[i] != '\\' || (i < name_len && isPUNCT_A(name[i+1]))))
         {
             /* Find the property.  The table includes the equals sign, so we
              * use 'j' as-is */
@@ -23309,8 +23312,8 @@ Perl_parse_uniprop_string(pTHX_
                 const char * pos_in_brackets;
                 bool escaped = 0;
 
-                /* A backslash means the real delimitter is the next character.
-                 * */
+                /* Backslash => delimitter is the character following.  We
+                 * already checked that it is punctuation */
                 if (open == '\\') {
                     open = name[i++];
                     escaped = 1;

diff --git a/t/re/reg_mesg.t b/t/re/reg_mesg.t
index aa7e455..1ef912b 100644 (file)
--- a/t/re/reg_mesg.t
+++ b/t/re/reg_mesg.t
@@ -319,6 +319,7 @@ my @death =
  '/\x{100}(?(/' => 'Unknown switch condition (?(...)) {#} m/\\x{100}(?({#}/', # [perl #133896]
  '/(?[\N{KEYCAP DIGIT NINE}/' => '\N{} here is restricted to one character {#} m/(?[\\N{U+39.FE0F.20E3{#}}/', # [perl #133988]
  '/0000000000000000[\N{U+0.00}0000/' => 'Unmatched [ {#} m/0000000000000000[{#}\N{U+0.00}0000/', # [perl #134059]
+ '/\p{nv=\b5\b}/' => 'Can\'t find Unicode property definition "nv=\\b5\\b" {#} m/\\p{nv=\\b5\\b}{#}/',
 );
 
 # These are messages that are death under 'use re "strict"', and may or may