Change 27538 by [EMAIL PROTECTED] on 2006/03/17 22:12:27
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.
Affected files ...
... //depot/perl/intrpvar.h#184 edit
... //depot/perl/sv.c#1190 edit
Differences ...
==== //depot/perl/intrpvar.h#184 (text) ====
Index: perl/intrpvar.h
--- perl/intrpvar.h#183~27525~ 2006-03-16 15:11:11.000000000 -0800
+++ perl/intrpvar.h 2006-03-17 14:12:27.000000000 -0800
@@ -553,7 +553,11 @@
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).
==== //depot/perl/sv.c#1190 (text) ====
Index: perl/sv.c
--- perl/sv.c#1189~27537~ 2006-03-17 12:39:47.000000000 -0800
+++ perl/sv.c 2006-03-17 14:12:27.000000000 -0800
@@ -5285,28 +5285,43 @@
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);
}
}
End of Patch.
