Make Perl_sv_len_utf8 honour the new ${^UTF8CACHE}.

If PERL_UTF8_CACHE_ASSERT is defined, default ${^UTF8CACHE} to -1
(assertion mode). Need a way to turn this on with existing command
line flags.

p4raw-id: //depot/perl@27538

diff --git a/intrpvar.h b/intrpvar.h
index aa31aaf..3908e5b 100644 (file)
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -553,7 +553,11 @@ PERLVARI(Imy_cxt_list, void **, NULL) /* per-module array of MY_CXT pointers */
 PERLVAR(Imemory_debug_header, struct perl_memory_debug_header)
 #endif
 
-PERLVARI(Iutf8cache, signed char, 1)   /* Is the utf8 caching code enabled? */
+#ifdef PERL_UTF8_CACHE_ASSERT
+PERLVARI(Iutf8cache, I8, -1)   /* Is the utf8 caching code enabled? */
+#else
+PERLVARI(Iutf8cache, I8, 1)    /* Is the utf8 caching code enabled? */
+#endif
 
 /* New variables must be added to the very end, before this comment,
  * for binary compatibility (the offsets of the old members must not change).

diff --git a/sv.c b/sv.c
index d981d88..78e0d24 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -5285,28 +5285,43 @@ Perl_sv_len_utf8(pTHX_ register SV *sv)
        return mg_length(sv);
     else
     {
-       STRLEN len, ulen;
+       STRLEN len;
        const U8 *s = (U8*)SvPV_const(sv, len);
-       MAGIC *mg = SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : 0;
 
-       if (mg && mg->mg_len != -1) {
-           ulen = mg->mg_len;
-#ifdef PERL_UTF8_CACHE_ASSERT
-           assert(ulen == Perl_utf8_length(aTHX_ s, s + len));
-#endif
-       }
-       else {
-           ulen = Perl_utf8_length(aTHX_ s, s + len);
-           if (!SvREADONLY(sv)) {
-               if (!mg) {
-                   sv_magic(sv, 0, PERL_MAGIC_utf8, 0, 0);
-                   mg = mg_find(sv, PERL_MAGIC_utf8);
+       if (PL_utf8cache) {
+           STRLEN ulen;
+           MAGIC *mg = SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : 0;
+
+           if (mg && mg->mg_len != -1) {
+               ulen = mg->mg_len;
+               if (PL_utf8cache < 0) {
+                   const STRLEN real = Perl_utf8_length(aTHX_ s, s + len);
+                   if (real != ulen) {
+                       /* Need to turn the assertions off otherwise we may
+                          recurse infinitely while printing error messages.
+                       */
+                       SAVEI8(PL_utf8cache);
+                       PL_utf8cache = 0;
+                       Perl_croak(aTHX_ "panic: sv_len_utf8 cache %"UVf
+                                  "real %"UVf" for %"SVf,
+                                  (UV) ulen, (UV) real, sv);
+                   }
+               }
+           }
+           else {
+               ulen = Perl_utf8_length(aTHX_ s, s + len);
+               if (!SvREADONLY(sv)) {
+                   if (!mg) {
+                       mg = sv_magicext(sv, 0, PERL_MAGIC_utf8,
+                                        &PL_vtbl_utf8, 0, 0);
+                   }
                    assert(mg);
+                   mg->mg_len = ulen;
                }
-               mg->mg_len = ulen;
            }
+           return ulen;
        }
-       return ulen;
+       return Perl_utf8_length(aTHX_ s, s + len);
     }
 }