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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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;