In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/fde84d2e7382e53c871f09ac324785f8accc38b3?hp=e14160708b4f2129dece6ee10bdf6cb7f5abbadb>
- Log ----------------------------------------------------------------- commit fde84d2e7382e53c871f09ac324785f8accc38b3 Author: David Mitchell <[email protected]> Date: Fri Aug 4 08:51:49 2017 +0100 make utf8::upgrade() of a REGEXP a NOOP RT #131821 After my recent commit v5.27.2-30-gdf6b4bd, "give REGEXP SVs the POK flag again", $r = qr/.../; utf8::upgrade($$r); was setting the utf8 flag on the compiled REGEXP SV, which made no sense, as the regex was already compiled and individual nodes would remain non-utf8. The POK flag was removed from REGEXPs in 5.18.0, but before then it didn't seem to matter if the utf8 flag got set later, but it does now - it broke a Tk test. M sv.c M t/op/qr.t commit 97f6857b5c2a8f177be8d0a3fad2b17f2178e448 Author: David Mitchell <[email protected]> Date: Tue Aug 1 10:18:47 2017 +0100 fix RX_MATCH_UTF8_on() macro v5.27.2-34-g196a02a reorganised the RX_FOO() macros, mostly redefining them in terms of the RXp_FOO() macros. A cut-an-paste error screwed up the definition of RX_MATCH_UTF8_on(), which is isn't used in core. M regexp.h ----------------------------------------------------------------------- Summary of changes: regexp.h | 2 +- sv.c | 7 ++++++- t/op/qr.t | 11 ++++++++++- 3 files changed, 17 insertions(+), 3 deletions(-) diff --git a/regexp.h b/regexp.h index 2b8ba89b56..b22ada5c6b 100644 --- a/regexp.h +++ b/regexp.h @@ -567,7 +567,7 @@ and check for NULL. #define RXp_MATCH_UTF8(prog) (RXp_EXTFLAGS(prog) & RXf_MATCH_UTF8) #define RX_MATCH_UTF8(rx_sv) (RX_EXTFLAGS(rx_sv) & RXf_MATCH_UTF8) #define RXp_MATCH_UTF8_on(prog) (RXp_EXTFLAGS(prog) |= RXf_MATCH_UTF8) -#define RX_MATCH_UTF8_on(rx_sv) (RXp_EXTFLAGS(ReANY(rx_sv))) +#define RX_MATCH_UTF8_on(rx_sv) (RXp_MATCH_UTF8_on(ReANY(rx_sv))) #define RXp_MATCH_UTF8_off(prog) (RXp_EXTFLAGS(prog) &= ~RXf_MATCH_UTF8) #define RX_MATCH_UTF8_off(rx_sv) (RXp_MATCH_UTF8_off(ReANY(rx_sv)) #define RXp_MATCH_UTF8_set(prog, t) ((t) \ diff --git a/sv.c b/sv.c index 777f49e6da..b32db9632b 100644 --- a/sv.c +++ b/sv.c @@ -3462,7 +3462,12 @@ Perl_sv_utf8_upgrade_flags_grow(pTHX_ SV *const sv, const I32 flags, STRLEN extr } } - if (SvUTF8(sv)) { + /* SVt_REGEXP's shouldn't be upgraded to UTF8 - they're already + * compiled and individual nodes will remain non-utf8 even if the + * stringified version of the pattern gets upgraded. Whether the + * PVX of a REGEXP should be grown or we should just croak, I don't + * know - DAPM */ + if (SvUTF8(sv) || isREGEXP(sv)) { if (extra) SvGROW(sv, SvCUR(sv) + extra); return SvCUR(sv); } diff --git a/t/op/qr.t b/t/op/qr.t index 3ce74864d6..2944a0e04d 100644 --- a/t/op/qr.t +++ b/t/op/qr.t @@ -7,7 +7,7 @@ BEGIN { require './test.pl'; } -plan(tests => 32); +plan(tests => 33); sub r { return qr/Good/; @@ -110,3 +110,12 @@ sub { is $_[0], "$str ", 'stringifying regexpvlv in place'; } ->((\my%hash)->{key}); + +# utf8::upgrade on an SVt_REGEXP should be a NOOP. +# RT #131821 + +{ + my $r1 = qr/X/i; + utf8::upgrade($$r1); + like "xxx", $r1, "RT #131821 utf8::upgrade: case insensitive"; +} -- Perl5 Master Repository
