This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
make utf8::upgrade() of a REGEXP a NOOP
authorDavid Mitchell <davem@iabyn.com>
Fri, 4 Aug 2017 07:51:49 +0000 (08:51 +0100)
committerDavid Mitchell <davem@iabyn.com>
Fri, 4 Aug 2017 08:12:10 +0000 (09:12 +0100)
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.

sv.c
t/op/qr.t

diff --git a/sv.c b/sv.c
index 777f49e..b32db96 100644 (file)
--- 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);
     }
index 3ce7486..2944a0e 100644 (file)
--- 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";
+}