Stop substr lvalues from being confused by changing UTF8ness
authorFather Chrysostomos <sprout@cpan.org>
Fri, 28 Sep 2012 12:52:36 +0000 (05:52 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Mon, 1 Oct 2012 19:51:53 +0000 (12:51 -0700)
inline.h
mg.c
sv.h
t/op/utf8cache.t

index c55ce23..c2686fe 100644 (file)
--- a/inline.h
+++ b/inline.h
@@ -92,3 +92,15 @@ S_SvPADSTALE_off(SV *sv)
     assert(SvFLAGS(sv) & SVs_PADMY);
     return SvFLAGS(sv) &= ~SVs_PADSTALE;
 }
+#ifdef PERL_CORE
+PERL_STATIC_INLINE STRLEN
+sv_or_pv_pos_u2b(aTHX_ SV *sv, const char *pv, STRLEN pos, STRLEN *lenp)
+{
+    if (SvGAMAGIC(sv)) {
+       U8 *hopped = utf8_hop((U8 *)pv, pos);
+       if (lenp) *lenp = (STRLEN)(utf8_hop(hopped, *lenp) - hopped);
+       return (STRLEN)(hopped - (U8 *)pv);
+    }
+    return sv_pos_u2b_flags(sv,pos,lenp,SV_CONST_RETURN);
+}
+#endif
diff --git a/mg.c b/mg.c
index 4ba96a4..d6561c9 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -2199,7 +2199,7 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
        pos = len;
 
     if (ulen) {
-       pos = sv_or_pv_pos_u2b(lsv, s, pos);
+       pos = sv_or_pv_pos_u2b(lsv, s, pos, 0);
     }
 
     found->mg_len = pos;
@@ -2223,7 +2223,7 @@ Perl_magic_getsubstr(pTHX_ SV *sv, MAGIC *mg)
     PERL_UNUSED_ARG(mg);
 
     if (!translate_substr_offsets(
-           SvUTF8(lsv) ? sv_len_utf8_nomg(lsv) : len,
+           SvUTF8(lsv) ? sv_or_pv_len_utf8(lsv, tmps, len) : len,
            negoff ? -(IV)offs : (IV)offs, !negoff,
            negrem ? -(IV)rem  : (IV)rem,  !negrem, &offs, &rem
     )) {
@@ -2233,7 +2233,7 @@ Perl_magic_getsubstr(pTHX_ SV *sv, MAGIC *mg)
     }
 
     if (SvUTF8(lsv))
-       offs = sv_pos_u2b_flags(lsv, offs, &rem, SV_CONST_RETURN);
+       offs = sv_or_pv_pos_u2b(lsv, tmps, offs, &rem);
     sv_setpvn(sv, tmps + offs, rem);
     if (SvUTF8(lsv))
         SvUTF8_on(sv);
diff --git a/sv.h b/sv.h
index 2ac6c50..c2b0f57 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -1823,10 +1823,6 @@ mg.c:1024: warning: left-hand operand of comma expression has no effect
     (SvGAMAGIC(sv)                                    \
        ? utf8_length((U8 *)(pv), (U8 *)(pv)+(bytelen)) \
        : sv_len_utf8(sv))
-# define sv_or_pv_pos_u2b(sv, pv, pos)                  \
-    (SvGAMAGIC(sv)                                       \
-       ? (STRLEN)(utf8_hop((U8 *)(pv), pos) - (U8 *)(pv)) \
-       : sv_pos_u2b_flags(sv,pos,0,0))
 #endif
 
 /*
index 2d10332..556cceb 100644 (file)
@@ -9,7 +9,7 @@ BEGIN {
 
 use strict;
 
-plan(tests => 7);
+plan(tests => 9);
 
 SKIP: {
 skip_without_dynamic_extension("Devel::Peek");
@@ -108,4 +108,12 @@ pos $u = 2;
 is pos $u, 2, 'pos on overloaded utf8 toggler';
 () = "$u"; # flip flag
 pos $u = 2;
-is pos $u, 2, 'pos on overloaded utf8 toggler (again)'
+is pos $u, 2, 'pos on overloaded utf8 toggler (again)';
+
+() = ord ${\substr $u, 1};
+is ord ${\substr($u, 1)}, 0xc2,
+    'utf8 cache + overloading does not confuse substr lvalues';
+() = "$u"; # flip flag
+() = ord substr $u, 1;
+is ord substr($u, 1), 0xc2,
+    'utf8 cache + overloading does not confuse substr lvalues (again)';