This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make substr assignment work with changing UTF8ness
authorFather Chrysostomos <sprout@cpan.org>
Sun, 30 Sep 2012 20:04:53 +0000 (13:04 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Mon, 1 Oct 2012 19:51:57 +0000 (12:51 -0700)
Assigning to a substr lvalue scalar was invoking overload too
many times if the target was a UTF8 string and the assigned sub-
string was not.

Since sv_insert_flags itself stringifies the scalar, the easiest
way to fix this is to force the target to a PV before doing any-
thing to it.

mg.c
t/op/utf8cache.t

diff --git a/mg.c b/mg.c
index fd06aa4..5ea262b 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -2167,7 +2167,6 @@ 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);
@@ -2182,8 +2181,8 @@ Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
        Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR),
                            "Attempt to use reference as lvalue in substr"
        );
-    targs = SvPV_nomg(lsv,lsv_len);
-    if (SvUTF8(lsv)) lsv_len = sv_or_pv_len_utf8(lsv,targs,lsv_len);
+    SvPV_force_nomg(lsv,lsv_len);
+    if (SvUTF8(lsv)) lsv_len = sv_len_utf8_nomg(lsv);
     if (!translate_substr_offsets(
            lsv_len,
            negoff ? -(IV)lvoff : (IV)lvoff, !negoff,
index 9e78e72..65254b1 100644 (file)
@@ -9,7 +9,7 @@ BEGIN {
 
 use strict;
 
-plan(tests => 13);
+plan(tests => 15);
 
 SKIP: {
 skip_without_dynamic_extension("Devel::Peek");
@@ -118,6 +118,18 @@ is ord ${\substr($u, 1)}, 0xc2,
 is ord substr($u, 1), 0xc2,
     'utf8 cache + overloading does not confuse substr lvalues (again)';
 
+$u = UTF8Toggle->new(" \x{c2}7 ");
+() = ord ${\substr $u, 2};
+{ no warnings; ${\substr($u, 2, 1)} = 0; }
+is $u, " \x{c2}0 ",
+    'utf8 cache + overloading does not confuse substr lvalue assignment';
+$u = UTF8Toggle->new(" \x{c2}7 ");
+() = "$u"; # flip flag
+() = ord ${\substr $u, 2};
+{ no warnings; ${\substr($u, 2, 1)} = 0; }
+is $u, " \x{c2}0 ",
+    'utf8 cache + overload does not confuse substr lv assignment (again)';
+
 
 # Typeglobs and references should not get a cache
 use utf8;