Fix use_ok() in vmsish.t broken by 46d4dcbda33f17cc.

[perl5.git] / pp_hot.c

diff --git a/pp_hot.c b/pp_hot.c
index bd0402a..66198a2 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -908,7 +908,7 @@ PP(pp_rv2av)
        /* The guts of pp_rv2hv  */
        if (gimme == G_ARRAY) { /* array wanted */
            *PL_stack_sp = sv;
-           return do_kv();
+           return Perl_do_kv(aTHX);
        }
        else if (gimme == G_SCALAR) {
            dTARGET;
@@ -2161,7 +2161,7 @@ PP(pp_subst)
        s = CALLREG_INTUIT_START(rx, TARG, s, strend, r_flags, NULL);
 
        if (!s)
-           goto nope;
+           goto ret_no;
        /* How to do it in subst? */
 /*     if ( (RX_EXTFLAGS(rx) & RXf_CHECK_ALL)
             && !PL_sawampersand
@@ -2185,12 +2185,13 @@ PP(pp_subst)
         * http://www.nntp.perl.org/group/perl.perl5.porters/2010/04/msg158809.html
         */
        if (matched && DO_UTF8(dstr) && ! DO_UTF8(TARG)) {
-           const STRLEN new_len = sv_utf8_upgrade(TARG);
+           char * const orig_pvx =  SvPVX(TARG);
+           const STRLEN new_len = sv_utf8_upgrade_nomg(TARG);
 
            /* If the lengths are the same, the pattern contains only
             * invariants, can keep going; otherwise, various internal markers
             * could be off, so redo */
-           if (new_len != len) {
+           if (new_len != len || orig_pvx != SvPVX(TARG)) {
                goto setup_match;
            }
        }
@@ -2216,6 +2217,14 @@ PP(pp_subst)
        doutf8 = FALSE;
     }
     
+    if (!matched) {
+      ret_no:
+       SPAGAIN;
+       PUSHs(rpm->op_pmflags & PMf_NONDESTRUCT ? TARG : &PL_sv_no);
+       LEAVE_SCOPE(oldsave);
+       RETURN;
+    }
+
     /* can do inplace substitution? */
     if (c
 #ifdef PERL_OLD_COPY_ON_WRITE
@@ -2223,17 +2232,9 @@ PP(pp_subst)
 #endif
        && (I32)clen <= RX_MINLENRET(rx) && (once || !(r_flags & REXEC_COPY_STR))
        && !(RX_EXTFLAGS(rx) & RXf_LOOKBEHIND_SEEN)
-       && (!doutf8 || SvUTF8(TARG))) {
-       if (!matched)
-       {
-           SPAGAIN;
-           if (rpm->op_pmflags & PMf_NONDESTRUCT)
-               PUSHs(TARG);
-           else
-               PUSHs(&PL_sv_no);
-           LEAVE_SCOPE(oldsave);
-           RETURN;
-       }
+       && (!doutf8 || SvUTF8(TARG)))
+    {
+
 #ifdef PERL_OLD_COPY_ON_WRITE
        if (SvIsCOW(TARG)) {
            assert (!force_on_match);
@@ -2284,10 +2285,7 @@ PP(pp_subst)
            }
            TAINT_IF(rxtainted & 1);
            SPAGAIN;
-           if (rpm->op_pmflags & PMf_NONDESTRUCT)
-               PUSHs(TARG);
-           else
-               PUSHs(&PL_sv_yes);
+           PUSHs(rpm->op_pmflags & PMf_NONDESTRUCT ? TARG : &PL_sv_yes);
        }
        else {
            do {
@@ -2321,22 +2319,8 @@ PP(pp_subst)
            else
                mPUSHi((I32)iters);
        }
-       (void)SvPOK_only_UTF8(TARG);
-       TAINT_IF(rxtainted);
-       if (SvSMAGICAL(TARG)) {
-           PUTBACK;
-           mg_set(TARG);
-           SPAGAIN;
-       }
-       SvTAINT(TARG);
-       if (doutf8)
-           SvUTF8_on(TARG);
-       LEAVE_SCOPE(oldsave);
-       RETURN;
     }
-
-    if (matched)
-    {
+    else {
        if (force_on_match) {
            force_on_match = 0;
            s = SvPV_force(TARG, len);
@@ -2409,25 +2393,13 @@ PP(pp_subst)
            PUSHs(TARG);
        else
            mPUSHi((I32)iters);
-
-       (void)SvPOK_only(TARG);
-       if (doutf8)
-           SvUTF8_on(TARG);
-       TAINT_IF(rxtainted);
-       SvSETMAGIC(TARG);
-       SvTAINT(TARG);
-       LEAVE_SCOPE(oldsave);
-       RETURN;
     }
-    goto ret_no;
-
-nope:
-ret_no:
-    SPAGAIN;
-    if (rpm->op_pmflags & PMf_NONDESTRUCT)
-       PUSHs(TARG);
-    else
-       PUSHs(&PL_sv_no);
+    (void)SvPOK_only_UTF8(TARG);
+    if (doutf8)
+       SvUTF8_on(TARG);
+    TAINT_IF(rxtainted);
+    SvSETMAGIC(TARG);
+    SvTAINT(TARG);
     LEAVE_SCOPE(oldsave);
     RETURN;
 }