Break S_utf8_mg_len_cache_update() out from Perl_sv_len_utf8().
authorNicholas Clark <nick@ccl4.org>
Mon, 12 Jul 2010 10:16:41 +0000 (11:16 +0100)
committerNicholas Clark <nick@ccl4.org>
Mon, 12 Jul 2010 12:43:19 +0000 (13:43 +0100)
embed.fnc
embed.h
proto.h
sv.c

index 15bd938..99f4b13 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -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 \
diff --git a/embed.h b/embed.h
index 5e79e58..b34fffb 100644 (file)
--- a/embed.h
+++ b/embed.h
 #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
 #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
diff --git a/proto.h b/proto.h
index 535dc78..6fc11dd 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -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);
diff --git a/sv.c b/sv.c
index 3e99d9c..a3bc6e1 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -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()