summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2012-09-30 13:04:53 -0700
committerFather Chrysostomos <sprout@cpan.org>2012-10-01 12:51:57 -0700
commitfc061ed836b74a70a080622eebe8d7f247fb1990 (patch)
tree8e965beeb922eab00b894353dca1b38629635406
parent0d3361061f711b74d2c4870d5539c31071de0df1 (diff)
downloadperl-fc061ed836b74a70a080622eebe8d7f247fb1990.tar.gz
Make substr assignment work with changing UTF8ness
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.
-rw-r--r--mg.c5
-rw-r--r--t/op/utf8cache.t14
2 files changed, 15 insertions, 4 deletions
diff --git a/mg.c b/mg.c
index fd06aa4040..5ea262bd48 100644
--- 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,
diff --git a/t/op/utf8cache.t b/t/op/utf8cache.t
index 9e78e720c6..65254b1b47 100644
--- a/t/op/utf8cache.t
+++ b/t/op/utf8cache.t
@@ -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;