develooper Front page | perl.perl5.porters | Postings from December 2009

[PATCH 3/3] avoid infinite chain of utf8 magic

From:
Chip Salzenberg
Date:
December 5, 2009 21:28
Subject:
[PATCH 3/3] avoid infinite chain of utf8 magic
Message ID:
E1NH9fs-0000zi-Q2@tytlal
---
 sv.c |   19 +++++++++++++------
 1 files changed, 13 insertions(+), 6 deletions(-)

diff --git a/sv.c b/sv.c
index 811d8ce..5162d2e 100644
--- a/sv.c
+++ b/sv.c
@@ -6016,7 +6016,8 @@ Perl_sv_len_utf8(pTHX_ register SV *const sv)
 	    else {
 		ulen = Perl_utf8_length(aTHX_ s, s + len);
 		if (!SvREADONLY(sv)) {
-		    if (!mg) {
+		    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);
 		    }
@@ -6096,8 +6097,10 @@ S_sv_pos_u2b_cached(pTHX_ SV *const sv, MAGIC **const mgp, const U8 *const start
 
     assert (uoffset >= uoffset0);
 
-    if (SvMAGICAL(sv) && !SvREADONLY(sv) && PL_utf8cache
-	&& (*mgp || (*mgp = mg_find(sv, PERL_MAGIC_utf8)))) {
+    if (!SvREADONLY(sv)
+	&& PL_utf8cache
+	&& (*mgp || (SvTYPE(sv) >= SVt_PVMG &&
+		     (*mgp = mg_find(sv, PERL_MAGIC_utf8))))) {
 	if ((*mgp)->mg_ptr) {
 	    STRLEN *cache = (STRLEN *) (*mgp)->mg_ptr;
 	    if (cache[0] == uoffset) {
@@ -6280,7 +6283,8 @@ S_utf8_mg_pos_cache_update(pTHX_ SV *const sv, MAGIC **const mgp, const STRLEN b
     if (SvREADONLY(sv))
 	return;
 
-    if (!*mgp) {
+    if (!*mgp && (SvTYPE(sv) < SVt_PVMG ||
+		  !(*mgp = mg_find(sv, PERL_MAGIC_utf8)))) {
 	*mgp = sv_magicext(sv, 0, PERL_MAGIC_utf8, (MGVTBL*)&PL_vtbl_utf8, 0,
 			   0);
 	(*mgp)->mg_len = -1;
@@ -6477,8 +6481,11 @@ Perl_sv_pos_b2u(pTHX_ register SV *const sv, I32 *const offsetp)
 
     send = s + byte;
 
-    if (SvMAGICAL(sv) && !SvREADONLY(sv) && PL_utf8cache
-	&& (mg = mg_find(sv, PERL_MAGIC_utf8))) {
+    if (!SvREADONLY(sv)
+	&& PL_utf8cache
+	&& SvTYPE(sv) >= SVt_PVMG
+	&& (mg = mg_find(sv, PERL_MAGIC_utf8)))
+    {
 	if (mg->mg_ptr) {
 	    STRLEN * const cache = (STRLEN *) mg->mg_ptr;
 	    if (cache[1] == byte) {
-- 
1.6.5.4




nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About