This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regcomp.c: Fix named sequences in (?[...])
authorKarl Williamson <khw@cpan.org>
Wed, 22 Apr 2020 21:37:23 +0000 (15:37 -0600)
committerKarl Williamson <khw@cpan.org>
Wed, 29 Apr 2020 19:21:51 +0000 (13:21 -0600)
The regex_sets feature cannot yet handle named sequences possibly
returned by \p{name=...}.  I forgot to check for this possibility which
led to a null pointer dereference.  Also, the called function was
returning success when it should have failed in this circumstance.

This fixes #17732

pod/perldiag.pod
regcomp.c
t/re/reg_mesg.t

index 8ed25c1..a31adb9 100644 (file)
@@ -6683,6 +6683,15 @@ The closing delimtter to match the opening one was not found.  If the
 opening one is escaped by preceding it with a backslash, the closing one
 must also be so escaped.
 
+=item Unicode string properties are not implemented in (?[...]) in
+regex; marked by <-- HERE in m/%s/
+
+(F) A Unicode string property is one which expands to a sequence of
+multiple characters.  An example is C<\p{name=KATAKANA LETTER AINU P}>,
+which is comprised of the sequence C<\N{KATAKANA LETTER SMALL H}>
+followed by C<\N{COMBINING KATAKANA-HIRAGANA SEMI-VOICED SOUND MARK}>.
+Extended character classes, C<(?[...])> currently cannot handle these.
+
 =item Unicode surrogate U+%X is illegal in UTF-8
 
 (S surrogate) You had a UTF-16 surrogate in a context where they are
@@ -7406,6 +7415,22 @@ a range.  For these, what should happen isn't clear at all.  In
 these circumstances, Perl discards all but the first character
 of the returned sequence, which is not likely what you want.
 
+=item Using just the single character results returned by \p{} in
+(?[...]) in regex; marked by S<<-- HERE> in m/%s/
+
+(W regexp) Extended character classes currently cannot handle operands
+that evaluate to more than one character.  These are removed from the
+results of the expansion of the C<\p{}>.
+
+This situation can happen, for example, in
+
+ (?[ \p{name=/KATAKANA/} ])
+
+"KATAKANA LETTER AINU P" is a legal Unicode name (technically a "named
+sequence"), but it is actually two characters.  The above expression
+with match only the Unicode names containing KATAKANA that represent
+single characters.
+
 =item Using /u for '%s' instead of /%s in regex; marked by S<<-- HERE> in m/%s/
 
 (W regexp) You used a Unicode boundary (C<\b{...}> or C<\B{...}>) in a
index 8dd5c50..8e109b5 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -16517,6 +16517,8 @@ redo_curchar:
                     goto regclass_failed;
                 }
 
+                assert(current);
+
                 /* regclass() will return with parsing just the \ sequence,
                  * leaving the parse pointer at the next thing to parse */
                 RExC_parse--;
@@ -16554,9 +16556,7 @@ redo_curchar:
                     goto regclass_failed;
                 }
 
-                if (! current) {
-                    break;
-                }
+                assert(current);
 
                 /* function call leaves parse pointing to the ']', except if we
                  * faked it */
@@ -17740,7 +17740,18 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
                     assert(prop_definition || strings);
 
                     if (strings) {
-                        if (! RExC_in_multi_char_class) {
+                        if (ret_invlist) {
+                            if (! prop_definition) {
+                                RExC_parse = e + 1;
+                                vFAIL("Unicode string properties are not implemented in (?[...])");
+                            }
+                            else {
+                                ckWARNreg(e + 1,
+                                    "Using just the single character results"
+                                    " returned by \\p{} in (?[...])");
+                            }
+                        }
+                        else if (! RExC_in_multi_char_class) {
                             if (invert ^ (value == 'P')) {
                                 RExC_parse = e + 1;
                                 vFAIL("Inverting a character class which contains"
@@ -18969,7 +18980,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
     if (ret_invlist) {
         *ret_invlist = cp_list;
 
-        return RExC_emit;
+        return (cp_list) ? RExC_emit : 0;
     }
 
     if (anyof_flags & ANYOF_LOCALE_FLAGS) {
index 6c26268..9f1c417 100644 (file)
@@ -331,6 +331,7 @@ my @death =
  '/\p{gc=:\PS:}/' => 'Use of \'\\PS\' is not allowed in Unicode property wildcard subpatterns {#} m/\\PS{#}/',
  '/\p{gc=:[\pS]:}/' => 'Use of \'\\pS\' is not allowed in Unicode property wildcard subpatterns {#} m/[\\pS{#}]/',
  '/\p{gc=:[\PS]:}/' => 'Use of \'\\PS\' is not allowed in Unicode property wildcard subpatterns {#} m/[\\PS{#}]/',
+ '/(?[\p{name=KATAKANA LETTER AINU P}])/' => 'Unicode string properties are not implemented in (?[...]) {#} m/(?[\p{name=KATAKANA LETTER AINU P}{#}])/',
 );
 
 # These are messages that are death under 'use re "strict"', and may or may
@@ -708,6 +709,15 @@ my @experimental_regex_sets = (
     '/noutf8 ãƒ (?[ [\tネ] ])/' => 'The regex_sets feature is experimental {#} m/noutf8 ãƒ (?[{#} [\tネ] ])/',
 );
 
+my @wildcard = (
+    'm!(?[\p{name=/KATAKANA/}])$!' =>
+    [
+     'The regex_sets feature is experimental {#} m/(?[{#}\p{name=/KATAKANA/}])$/',
+     'The Unicode property wildcards feature is experimental',
+     'Using just the single character results returned by \p{} in (?[...]) {#} m/(?[\p{name=/KATAKANA/}{#}])$/'
+    ], # [GH #17732] Null pointer deref
+);
+
 my @deprecated = (
  '/^{/'          => "",
  '/foo|{/'       => "",
@@ -797,6 +807,7 @@ for my $strict ("",  "no warnings 'experimental::re_strict'; use re 'strict';")
 
     foreach my $ref (\@warning_tests,
                      \@experimental_regex_sets,
+                     \@wildcard,
                      \@deprecated)
     {
         my $warning_type;
@@ -815,6 +826,10 @@ for my $strict ("",  "no warnings 'experimental::re_strict'; use re 'strict';")
             $warning_type = 'experimental::regex_sets';
             $default_on = 1;
         }
+        elsif ($ref == \@wildcard) {
+            $warning_type = 'experimental::regex_sets, experimental::uniprop_wildcards';
+            $default_on = 1;
+        }
         else {
             fail("$0: Internal error: Unexpected loop variable");
         }