In perl.git, the branch blead has been updated <https://perl5.git.perl.org/perl.git/commitdiff/0605d0e2d32ab0609d236ed420e2c1fa51a73b0b?hp=2b9c8be2c787ef71cd93339abeb95c64fdd07abc>
- Log ----------------------------------------------------------------- commit 0605d0e2d32ab0609d236ed420e2c1fa51a73b0b Merge: 2b9c8be2c7 4531f512e1 Author: Sawyer X <[email protected]> Date: Fri May 17 21:18:23 2019 +0300 Merge branch 'smoke-me/khw-petr' into blead ----------------------------------------------------------------------- Summary of changes: regcomp.c | 37 +++++++++++++++++++++++++++++++------ t/uni/class.t | 19 ++++++++++++++++++- 2 files changed, 49 insertions(+), 7 deletions(-) diff --git a/regcomp.c b/regcomp.c index fbd5c1809a..9bd6dd3739 100644 --- a/regcomp.c +++ b/regcomp.c @@ -23054,6 +23054,14 @@ Perl_parse_uniprop_string(pTHX_ if (could_be_user_defined) { CV* user_sub; + /* If the user defined property returns the empty string, it could + * easily be because the pattern is being compiled before the data it + * actually needs to compile is available. This could be argued to be + * a bug in the perl code, but this is a change of behavior for Perl, + * so we handle it. This means that intentionally returning nothing + * will not be resolved until runtime */ + bool empty_return = FALSE; + /* Here, the name could be for a user defined property, which are * implemented as subs. */ user_sub = get_cvn_flags(name, name_len, 0); @@ -23285,16 +23293,28 @@ Perl_parse_uniprop_string(pTHX_ prop_definition = NULL; } else { /* G_SCALAR guarantees a single return value */ + SV * contents = POPs; /* The contents is supposed to be the expansion of the property - * definition. Call a function to check for valid syntax and - * handle it */ - prop_definition = handle_user_defined_property(name, name_len, + * definition. If the definition is deferrable, and we got an + * empty string back, set a flag to later defer it (after clean + * up below). */ + if ( deferrable + && (! SvPOK(contents) || SvCUR(contents) == 0)) + { + empty_return = TRUE; + } + else { /* Otherwise, call a function to check for valid syntax, + and handle it */ + + prop_definition = handle_user_defined_property( + name, name_len, is_utf8, to_fold, runtime, deferrable, - POPs, user_defined_ptr, + contents, user_defined_ptr, msg, level); + } } /* Here, we have the results of the expansion. Delete the @@ -23306,8 +23326,9 @@ Perl_parse_uniprop_string(pTHX_ S_delete_recursion_entry(aTHX_ SvPVX(key)); - if (! prop_definition || is_invlist(prop_definition)) { - + if ( ! empty_return + && (! prop_definition || is_invlist(prop_definition))) + { /* If we got success we use the inversion list defining the * property; otherwise use the error message */ SWITCH_TO_GLOBAL_CONTEXT; @@ -23328,6 +23349,10 @@ Perl_parse_uniprop_string(pTHX_ LEAVE; POPSTACK; + if (empty_return) { + goto definition_deferred; + } + if (prop_definition) { /* If the definition is for something not known at this time, diff --git a/t/uni/class.t b/t/uni/class.t index 37392aabed..572a538004 100644 --- a/t/uni/class.t +++ b/t/uni/class.t @@ -5,7 +5,7 @@ BEGIN { skip_all_without_unicode_tables(); } -plan tests => 11; +plan tests => 12; my $str = join "", map { chr utf8::unicode_to_native($_) } 0x20 .. 0x6F; @@ -88,5 +88,22 @@ $str = "[\x{038B}\x{038C}\x{038D}]"; is(($str =~ /(\p{InGreek}+)/)[0], "\x{038B}\x{038C}\x{038D}"); +{ # [perl #133860], compilation before data for it is available + package Foo; + + sub make { + my @lines; + while( my($c) = splice(@_,0,1) ) { + push @lines, sprintf("%04X", $c); + } + return join "\n", @lines; + } + + my @characters = ( ord("a") ); + sub IsProperty { make(@characters); }; + + main::like('a', qr/\p{IsProperty}/, "foo"); +} + # The other tests that are based on looking at the generated files are now # in t/re/uniprops.t -- Perl5 Master Repository
