diff options
| -rw-r--r-- | inline.h | 12 | ||||
| -rw-r--r-- | mg.c | 6 | ||||
| -rw-r--r-- | sv.h | 4 | ||||
| -rw-r--r-- | t/op/utf8cache.t | 12 |
4 files changed, 25 insertions, 9 deletions
@@ -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 @@ -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); @@ -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 /* diff --git a/t/op/utf8cache.t b/t/op/utf8cache.t index 2d10332fc4..556cceb11a 100644 --- a/t/op/utf8cache.t +++ b/t/op/utf8cache.t @@ -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)'; |