diff options
| -rw-r--r-- | embed.fnc | 2 | ||||
| -rw-r--r-- | embed.h | 2 | ||||
| -rw-r--r-- | proto.h | 6 | ||||
| -rw-r--r-- | sv.c | 34 |
4 files changed, 31 insertions, 13 deletions
@@ -1890,6 +1890,8 @@ sn |STRLEN |sv_pos_u2b_midway|NN const U8 *const start \ s |STRLEN |sv_pos_u2b_cached|NN SV *const sv|NN MAGIC **const mgp \ |NN const U8 *const start|NN const U8 *const send \ |STRLEN uoffset|STRLEN uoffset0|STRLEN boffset0 +s |void |utf8_mg_len_cache_update|NN SV *const sv|NN MAGIC **const mgp \ + |const STRLEN ulen s |void |utf8_mg_pos_cache_update|NN SV *const sv|NN MAGIC **const mgp \ |const STRLEN byte|const STRLEN utf8|const STRLEN blen s |STRLEN |sv_pos_b2u_midway|NN const U8 *const s|NN const U8 *const target \ @@ -1594,6 +1594,7 @@ #define sv_pos_u2b_forwards S_sv_pos_u2b_forwards #define sv_pos_u2b_midway S_sv_pos_u2b_midway #define sv_pos_u2b_cached S_sv_pos_u2b_cached +#define utf8_mg_len_cache_update S_utf8_mg_len_cache_update #define utf8_mg_pos_cache_update S_utf8_mg_pos_cache_update #define sv_pos_b2u_midway S_sv_pos_b2u_midway #define F0convert S_F0convert @@ -4044,6 +4045,7 @@ #define sv_pos_u2b_forwards S_sv_pos_u2b_forwards #define sv_pos_u2b_midway S_sv_pos_u2b_midway #define sv_pos_u2b_cached(a,b,c,d,e,f,g) S_sv_pos_u2b_cached(aTHX_ a,b,c,d,e,f,g) +#define utf8_mg_len_cache_update(a,b,c) S_utf8_mg_len_cache_update(aTHX_ a,b,c) #define utf8_mg_pos_cache_update(a,b,c,d,e) S_utf8_mg_pos_cache_update(aTHX_ a,b,c,d,e) #define sv_pos_b2u_midway(a,b,c,d) S_sv_pos_b2u_midway(aTHX_ a,b,c,d) #define F0convert S_F0convert @@ -5835,6 +5835,12 @@ STATIC STRLEN S_sv_pos_u2b_cached(pTHX_ SV *const sv, MAGIC **const mgp, const U #define PERL_ARGS_ASSERT_SV_POS_U2B_CACHED \ assert(sv); assert(mgp); assert(start); assert(send) +STATIC void S_utf8_mg_len_cache_update(pTHX_ SV *const sv, MAGIC **const mgp, const STRLEN ulen) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2); +#define PERL_ARGS_ASSERT_UTF8_MG_LEN_CACHE_UPDATE \ + assert(sv); assert(mgp) + STATIC void S_utf8_mg_pos_cache_update(pTHX_ SV *const sv, MAGIC **const mgp, const STRLEN byte, const STRLEN utf8, const STRLEN blen) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2); @@ -6065,19 +6065,7 @@ Perl_sv_len_utf8(pTHX_ register SV *const sv) } else { ulen = Perl_utf8_length(aTHX_ s, s + len); - if (!SvREADONLY(sv)) { - if (!mg && (SvTYPE(sv) < SVt_PVMG || - !(mg = mg_find(sv, PERL_MAGIC_utf8)))) { - mg = sv_magicext(sv, 0, PERL_MAGIC_utf8, - &PL_vtbl_utf8, 0, 0); - } - assert(mg); - mg->mg_len = ulen; - /* For now, treat "overflowed" as "still unknown". - See RT #72924. */ - if (ulen != (STRLEN) mg->mg_len) - mg->mg_len = -1; - } + utf8_mg_len_cache_update(sv, &mg, ulen); } return ulen; } @@ -6358,6 +6346,26 @@ Perl_sv_pos_u2b(pTHX_ register SV *const sv, I32 *const offsetp, I32 *const lenp } } +static void +S_utf8_mg_len_cache_update(pTHX_ SV *const sv, MAGIC **const mgp, + const STRLEN ulen) +{ + PERL_ARGS_ASSERT_UTF8_MG_LEN_CACHE_UPDATE; + if (SvREADONLY(sv)) + return; + + if (!*mgp && (SvTYPE(sv) < SVt_PVMG || + !(*mgp = mg_find(sv, PERL_MAGIC_utf8)))) { + *mgp = sv_magicext(sv, 0, PERL_MAGIC_utf8, &PL_vtbl_utf8, 0, 0); + } + assert(*mgp); + + (*mgp)->mg_len = ulen; + /* For now, treat "overflowed" as "still unknown". See RT #72924. */ + if (ulen != (STRLEN) (*mgp)->mg_len) + (*mgp)->mg_len = -1; +} + /* Create and update the UTF8 magic offset cache, with the proffered utf8/ byte length pairing. The (byte) length of the total SV is passed in too, as blen, because for some (more esoteric) SVs, the call to SvPV_const() |