Make magic_setsubstr check UTF8 flag after stringification
authorFather Chrysostomos <sprout@cpan.org>
Fri, 28 Sep 2012 12:52:53 +0000 (05:52 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Mon, 1 Oct 2012 19:51:54 +0000 (12:51 -0700)
By checking it before, it can end up treating a UTF8 string as bytes
when calculating offsets if the UTF8 flag is not turned on until
the target is stringified.  This can happen with overloading and
typeglobs.

This is a regression from 5.14.  5.14 itself was buggy, too, but one
would have to modify the target after creating the substr lvalue but
before assigning to it; and that because of another bug fixed by
83f78d1a27, which was cancelling out this one.

package o {
    use overload '""' => sub { $_[0][0] }
}
my $refee = bless ["\x{100}a"], o::;
my $substr = \substr $refee, -2;
$$substr = "b";
warn $refee;

That prints:

Wide character in warn at - line 7.
Āb at - line 7.

In 5.14 it prints:

b at - line 7.

mg.c
t/op/substr.t

index d6561c9..7b13f61 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -2246,6 +2246,7 @@ Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
     dVAR;
     STRLEN len, lsv_len, oldtarglen, newtarglen;
     const char * const tmps = SvPV_const(sv, len);
+    const char *targs;
     SV * const lsv = LvTARG(sv);
     STRLEN lvoff = LvTARGOFF(sv);
     STRLEN lvlen = LvTARGLEN(sv);
@@ -2260,8 +2261,8 @@ Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
        Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR),
                            "Attempt to use reference as lvalue in substr"
        );
-    if (SvUTF8(lsv)) lsv_len = sv_len_utf8_nomg(lsv);
-    else (void)SvPV_nomg(lsv,lsv_len);
+    targs = SvPV_nomg(lsv,lsv_len);
+    if (SvUTF8(lsv)) lsv_len = sv_or_pv_len_utf8(lsv,targs,lsv_len);
     if (!translate_substr_offsets(
            lsv_len,
            negoff ? -(IV)lvoff : (IV)lvoff, !negoff,
index fa8f67f..6a84052 100644 (file)
@@ -23,7 +23,7 @@ $SIG{__WARN__} = sub {
 
 BEGIN { require './test.pl'; }
 
-plan(381);
+plan(382);
 
 run_tests() unless caller;
 
@@ -817,3 +817,15 @@ is($destroyed, 1, 'Timely scalar destruction with lvalue substr');
 
     is($result_3363, "best", "ref-to-substr retains lvalue-ness under recursion [perl #3363]");
 }
+
+# Test that UTF8-ness of magic var changing does not confuse substr lvalue
+# assignment.
+# We use overloading for our magic var, but a typeglob would work, too.
+package o {
+    use overload '""' => sub { $_[0][0] }
+}
+my $refee = bless ["\x{100}a"], o::;
+my $substr = \substr $refee, -2;       # UTF8 flag still off for $$substr.
+$$substr = "b";                                # UTF8 flag turns on when setsubstr
+is $refee, "b",                                # magic stringifies $$substr.
+     'substr lvalue assignment when stringification turns on UTF8ness';