From: Karl Williamson <khw@cpan.org>
Date: Tue, 14 Apr 2020 23:44:08 +0000 (-0600)
Subject: regcomp.c: Don't allow \p{Is_Is_...}
X-Git-Tag: v5.33.1~112
X-Git-Url: https://perl5.git.perl.org/perl5.git/commitdiff_plain/3f8c7c3e1e1dd5fb1dc93324752d3cfd9c343db7

regcomp.c: Don't allow \p{Is_Is_...}

Only one 'Is_' prefix should be allowed.
---

diff --git a/regcomp.c b/regcomp.c
index b08453c..9fdc5e5 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -24670,8 +24670,10 @@ S_parse_uniprop_string(pTHX_
         /* Try again stripping off any initial 'Is'.  This is because we
          * promise that an initial Is is optional.  The same isn't true of
          * names that start with 'In'.  Those can match only blocks, and the
-         * lookup table already has those accounted for. */
-        if (starts_with_Is) {
+         * lookup table already has those accounted for.  The lookup table also
+         * has already accounted for Perl extensions (without and = sign)
+         * starting with 'i's'. */
+        if (starts_with_Is && equals_pos >= 0) {
             lookup_name += 2;
             lookup_len -= 2;
             equals_pos -= 2;
diff --git a/t/re/reg_mesg.t b/t/re/reg_mesg.t
index 9f1c417..145a91a 100644
--- a/t/re/reg_mesg.t
+++ b/t/re/reg_mesg.t
@@ -263,6 +263,7 @@ my @death =
  'm/(?[[^\N{LATIN CAPITAL LETTER A WITH MACRON AND GRAVE}]])/' => '\N{} here is restricted to one character {#} m/(?[[^\N{U+100.300{#}}]])/',
  'm/(?[ \p{Digit} & (?^(?[ \p{Thai} | \p{Lao} ]))])/' => 'Sequence (?^(...) not recognized {#} m/(?[ \p{Digit} & (?^({#}?[ \p{Thai} | \p{Lao} ]))])/',
  'm/(?[ \p{Digit} & (?(?[ \p{Thai} | \p{Lao} ]))])/' => 'Unexpected character {#} m/(?[ \p{Digit} & (?{#}(?[ \p{Thai} | \p{Lao} ]))])/',
+ 'm/\p{Is_Is_Any}/' => 'Unknown user-defined property name \p{main::Is_Is_Any}',
  'm/\o{/' => 'Missing right brace on \o{} {#} m/\o{{#}/',
  'm/\o/' => 'Missing braces on \o{} {#} m/\o{#}/',
  'm/\o{}/' => 'Empty \o{} {#} m/\o{}{#}/',