From: Nicholas Clark <nick@ccl4.org>
Date: Fri, 17 Mar 2006 13:38:34 +0000 (+0000)
Subject: sv_find() returning false, followed by sv_magic() to add the magic,
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d83f0a8247ea7458731c8479d8cbf3ee1fa81243;p=p5sagit%2Fp5-mst-13.2.git

sv_find() returning false, followed by sv_magic() to add the magic,
followed immediately by sv_find() to find it, is somewhat wasteful.
So use sv_magicext(). (All cases are also correct w.r.t. SvREADONLY())

p4raw-id: //depot/perl@27533
---

diff --git a/mg.c b/mg.c
index d82e9f0..2a38dda 100644
--- a/mg.c
+++ b/mg.c
@@ -1803,8 +1803,12 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
     if (!mg) {
 	if (!SvOK(sv))
 	    return 0;
-	sv_magic(lsv, NULL, PERL_MAGIC_regex_global, NULL, 0);
-	mg = mg_find(lsv, PERL_MAGIC_regex_global);
+#ifdef PERL_OLD_COPY_ON_WRITE
+    if (SvIsCOW(lsv))
+        sv_force_normal_flags(lsv, 0);
+#endif
+	mg = sv_magicext(lsv, NULL, PERL_MAGIC_regex_global, &PL_vtbl_mglob,
+			 NULL, 0);
     }
     else if (!SvOK(sv)) {
 	mg->mg_len = -1;
diff --git a/pp_ctl.c b/pp_ctl.c
index 4b0703b..87a383d 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -284,8 +284,12 @@ PP(pp_substcont)
 	if (SvTYPE(sv) < SVt_PVMG)
 	    SvUPGRADE(sv, SVt_PVMG);
 	if (!(mg = mg_find(sv, PERL_MAGIC_regex_global))) {
-	    sv_magic(sv, NULL, PERL_MAGIC_regex_global, NULL, 0);
-	    mg = mg_find(sv, PERL_MAGIC_regex_global);
+#ifdef PERL_OLD_COPY_ON_WRITE
+	    if (SvIsCOW(lsv))
+		sv_force_normal_flags(sv, 0);
+#endif
+	    mg = sv_magicext(sv, NULL, PERL_MAGIC_regex_global, &PL_vtbl_mglob,
+			     NULL, 0);
 	}
 	i = m - orig;
 	if (DO_UTF8(sv))
diff --git a/pp_hot.c b/pp_hot.c
index f28b042..c34fb90 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1405,8 +1405,12 @@ play_it_again:
 		if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG))
 		    mg = mg_find(TARG, PERL_MAGIC_regex_global);
 		if (!mg) {
-		    sv_magic(TARG, NULL, PERL_MAGIC_regex_global, NULL, 0);
-		    mg = mg_find(TARG, PERL_MAGIC_regex_global);
+#ifdef PERL_OLD_COPY_ON_WRITE
+		    if (SvIsCOW(TARG))
+			sv_force_normal_flags(TARG, 0);
+#endif
+		    mg = sv_magicext(TARG, NULL, PERL_MAGIC_regex_global,
+				     &PL_vtbl_mglob, NULL, 0);
 		}
 		if (rx->startp[0] != -1) {
 		    mg->mg_len = rx->endp[0];
@@ -1435,8 +1439,12 @@ play_it_again:
 	    else
 		mg = NULL;
 	    if (!mg) {
-		sv_magic(TARG, NULL, PERL_MAGIC_regex_global, NULL, 0);
-		mg = mg_find(TARG, PERL_MAGIC_regex_global);
+#ifdef PERL_OLD_COPY_ON_WRITE
+		if (SvIsCOW(TARG))
+		    sv_force_normal_flags(TARG, 0);
+#endif
+		mg = sv_magicext(TARG, NULL, PERL_MAGIC_regex_global,
+				 &PL_vtbl_mglob, NULL, 0);
 	    }
 	    if (rx->startp[0] != -1) {
 		mg->mg_len = rx->endp[0];
diff --git a/regexec.c b/regexec.c
index eb2480c..e802282 100644
--- a/regexec.c
+++ b/regexec.c
@@ -2130,9 +2130,12 @@ S_regtry(pTHX_ regexp *prog, char *startpos)
 	    if (!(SvTYPE(PL_reg_sv) >= SVt_PVMG && SvMAGIC(PL_reg_sv)
 		  && (mg = mg_find(PL_reg_sv, PERL_MAGIC_regex_global)))) {
 		/* prepare for quick setting of pos */
-		sv_magic(PL_reg_sv, (SV*)0,
-			PERL_MAGIC_regex_global, NULL, 0);
-		mg = mg_find(PL_reg_sv, PERL_MAGIC_regex_global);
+#ifdef PERL_OLD_COPY_ON_WRITE
+		if (SvIsCOW(sv))
+		    sv_force_normal_flags(sv, 0);
+#endif
+		mg = sv_magicext(PL_reg_sv, (SV*)0, PERL_MAGIC_regex_global,
+				 &PL_vtbl_mglob, NULL, 0);
 		mg->mg_len = -1;
 	    }
 	    PL_reg_magic    = mg;
diff --git a/sv.c b/sv.c
index 147d13b..1ec559c 100644
--- a/sv.c
+++ b/sv.c
@@ -5943,8 +5943,12 @@ Perl_sv_collxfrm(pTHX_ SV *sv, STRLEN *nxp)
 		return xf + sizeof(PL_collation_ix);
 	    }
 	    if (! mg) {
-		sv_magic(sv, 0, PERL_MAGIC_collxfrm, 0, 0);
-		mg = mg_find(sv, PERL_MAGIC_collxfrm);
+#ifdef PERL_OLD_COPY_ON_WRITE
+		if (SvIsCOW(sv))
+		    sv_force_normal_flags(sv, 0);
+#endif
+		mg = sv_magicext(sv, 0, PERL_MAGIC_collxfrm, &PL_vtbl_collxfrm,
+				 0, 0);
 		assert(mg);
 	    }
 	    mg->mg_ptr = xf;