#11739 was incomplete.
[p5sagit/p5-mst-13.2.git] / pp_hot.c
index c198b22..d219776 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -395,8 +395,8 @@ PP(pp_add)
        /* Unless the left argument is integer in range we are going to have to
           use NV maths. Hence only attempt to coerce the right argument if
           we know the left is integer.  */
-       register UV auv;
-       bool auvok;
+       register UV auv = 0;
+       bool auvok = FALSE;
        bool a_valid = 0;
 
        if (!useleft) {
@@ -558,7 +558,10 @@ PP(pp_print)
        gv = (GV*)*++MARK;
     else
        gv = PL_defoutgv;
-    if ((mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
+
+    if (gv && (io = GvIO(gv))
+       && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
+    {
       had_magic:
        if (MARK == ORIGMARK) {
            /* If using default handle then we need to make space to
@@ -570,7 +573,7 @@ PP(pp_print)
            ++SP;
        }
        PUSHMARK(MARK - 1);
-       *MARK = SvTIED_obj((SV*)gv, mg);
+       *MARK = SvTIED_obj((SV*)io, mg);
        PUTBACK;
        ENTER;
        call_method("PRINT", G_SCALAR);
@@ -582,8 +585,8 @@ PP(pp_print)
        RETURN;
     }
     if (!(io = GvIO(gv))) {
-        if ((GvEGV(gv))
-               && (mg = SvTIED_mg((SV*)GvEGV(gv), PERL_MAGIC_tiedscalar)))
+        if ((GvEGV(gv)) && (io = GvIO(GvEGV(gv)))
+           && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
             goto had_magic;
        if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
            report_evil_fh(gv, io, PL_op->op_type);
@@ -1190,7 +1193,7 @@ PP(pp_qr)
     register PMOP *pm = cPMOP;
     SV *rv = sv_newmortal();
     SV *sv = newSVrv(rv, "Regexp");
-    sv_magic(sv,(SV*)ReREFCNT_inc(pm->op_pmregexp), PERL_MAGIC_qr,0,0);
+    sv_magic(sv,(SV*)ReREFCNT_inc(PM_GETRE(pm)), PERL_MAGIC_qr,0,0);
     RETURNX(PUSHs(rv));
 }
 
@@ -1204,7 +1207,7 @@ PP(pp_match)
     I32 global;
     I32 r_flags = REXEC_CHECKED;
     char *truebase;                    /* Start of string  */
-    register REGEXP *rx = pm->op_pmregexp;
+    register REGEXP *rx = PM_GETRE(pm);
     bool rxtainted;
     I32 gimme = GIMME;
     STRLEN len;
@@ -1219,7 +1222,7 @@ PP(pp_match)
        TARG = DEFSV;
        EXTEND(SP,1);
     }
-    PL_reg_sv = TARG;
+
     PUTBACK;                           /* EVAL blocks need stack_sp. */
     s = SvPV(TARG, len);
     strend = s + len;
@@ -1229,6 +1232,8 @@ PP(pp_match)
                 (PL_tainted && (pm->op_pmflags & PMf_RETAINT)));
     TAINT_NOT;
 
+    PL_reg_sv_utf8 = DO_UTF8(TARG);
+
     if (pm->op_pmdynflags & PMdf_USED) {
       failure:
        if (gimme == G_ARRAY)
@@ -1238,7 +1243,7 @@ PP(pp_match)
 
     if (!rx->prelen && PL_curpm) {
        pm = PL_curpm;
-       rx = pm->op_pmregexp;
+       rx = PM_GETRE(pm);
     }
     if (rx->minlen > len) goto failure;
 
@@ -1328,11 +1333,27 @@ play_it_again:
                len = rx->endp[i] - rx->startp[i];
                s = rx->startp[i] + truebase;
                sv_setpvn(*SP, s, len);
-               if (DO_UTF8(TARG))
+               if (DO_UTF8(TARG) && is_utf8_string((U8*)s, len))
                    SvUTF8_on(*SP);
            }
        }
        if (global) {
+           if (pm->op_pmflags & PMf_CONTINUE) {
+               MAGIC* mg = 0;
+               if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG))
+                   mg = mg_find(TARG, PERL_MAGIC_regex_global);
+               if (!mg) {
+                   sv_magic(TARG, (SV*)0, PERL_MAGIC_regex_global, Nullch, 0);
+                   mg = mg_find(TARG, PERL_MAGIC_regex_global);
+               }
+               if (rx->startp[0] != -1) {
+                   mg->mg_len = rx->endp[0];
+                   if (rx->startp[0] == rx->endp[0])
+                       mg->mg_flags |= MGf_MINMATCH;
+                   else
+                       mg->mg_flags &= ~MGf_MINMATCH;
+               }
+           }
            had_zerolen = (rx->startp[0] != -1
                           && rx->startp[0] == rx->endp[0]);
            PUTBACK;                    /* EVAL blocks may use stack */
@@ -1379,7 +1400,7 @@ yup:                                      /* Confirmed by INTUIT */
     if (global) {
        rx->subbeg = truebase;
        rx->startp[0] = s - truebase;
-       if (DO_UTF8(PL_reg_sv)) {
+       if (PL_reg_sv_utf8) {
            char *t = (char*)utf8_hop((U8*)s, rx->minlen);
            rx->endp[0] = t - truebase;
        }
@@ -1434,9 +1455,9 @@ Perl_do_readline(pTHX)
     I32 gimme = GIMME_V;
     MAGIC *mg;
 
-    if ((mg = SvTIED_mg((SV*)PL_last_in_gv, PERL_MAGIC_tiedscalar))) {
+    if (io && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) {
        PUSHMARK(SP);
-       XPUSHs(SvTIED_obj((SV*)PL_last_in_gv, mg));
+       XPUSHs(SvTIED_obj((SV*)io, mg));
        PUTBACK;
        ENTER;
        call_method("READLINE", gimme);
@@ -1628,7 +1649,7 @@ PP(pp_helem)
     U32 defer = PL_op->op_private & OPpLVAL_DEFER;
     SV *sv;
     U32 hash = (SvFAKE(keysv) && SvREADONLY(keysv)) ? SvUVX(keysv) : 0;
-    I32 preeminent;
+    I32 preeminent = 0;
 
     if (SvTYPE(hv) == SVt_PVHV) {
        if (PL_op->op_private & OPpLVAL_INTRO)
@@ -1719,12 +1740,12 @@ PP(pp_leave)
        SP = newsp;
     else if (gimme == G_SCALAR) {
        MARK = newsp + 1;
-       if (MARK <= SP)
+       if (MARK <= SP) {
            if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP))
                *MARK = TOPs;
            else
                *MARK = sv_mortalcopy(TOPs);
-       else {
+       } else {
            MEXTEND(mark,0);
            *MARK = &PL_sv_undef;
        }
@@ -1875,11 +1896,10 @@ PP(pp_subst)
     bool rxtainted;
     char *orig;
     I32 r_flags;
-    register REGEXP *rx = pm->op_pmregexp;
+    register REGEXP *rx = PM_GETRE(pm);
     STRLEN len;
     int force_on_match = 0;
     I32 oldsave = PL_savestack_ix;
-    bool do_utf8;
     STRLEN slen;
 
     /* known replacement string? */
@@ -1890,8 +1910,7 @@ PP(pp_subst)
        TARG = DEFSV;
        EXTEND(SP,1);
     }
-    PL_reg_sv = TARG;
-    do_utf8 = DO_UTF8(PL_reg_sv);
+
     if (SvFAKE(TARG) && SvREADONLY(TARG))
        sv_force_normal(TARG);
     if (SvREADONLY(TARG)
@@ -1909,19 +1928,21 @@ PP(pp_subst)
        rxtainted |= 2;
     TAINT_NOT;
 
+    PL_reg_sv_utf8 = DO_UTF8(TARG);
+
   force_it:
     if (!pm || !s)
        DIE(aTHX_ "panic: pp_subst");
 
     strend = s + len;
-    slen = do_utf8 ? utf8_length((U8*)s, (U8*)strend) : len;
+    slen = PL_reg_sv_utf8 ? utf8_length((U8*)s, (U8*)strend) : len;
     maxiters = 2 * slen + 10;  /* We can match twice at each
                                   position, once with zero-length,
                                   second time with non-zero. */
 
     if (!rx->prelen && PL_curpm) {
        pm = PL_curpm;
-       rx = pm->op_pmregexp;
+       rx = PM_GETRE(pm);
     }
     r_flags = (rx->nparens || SvTEMP(TARG) || PL_sawampersand)
                ? REXEC_COPY_STR : 0;
@@ -2315,18 +2336,16 @@ PP(pp_leavesublv)
        else if (gimme == G_ARRAY) {
            EXTEND_MORTAL(SP - newsp);
            for (mark = newsp + 1; mark <= SP; mark++) {
-               if (SvFLAGS(*mark) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) {
+               if (*mark != &PL_sv_undef
+                   && SvFLAGS(*mark) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) {
                    /* Might be flattened array after $#array =  */
                    PUTBACK;
                    POPSUB(cx,sv);
                    PL_curpm = newpm;
                    LEAVE;
                    LEAVESUB(sv);
-                   DIE(aTHX_ "Can't return %s from lvalue subroutine",
-                       (*mark != &PL_sv_undef)
-                       ? (SvREADONLY(TOPs)
-                           ? "a readonly value" : "a temporary")
-                       : "an uninitialized value");
+                   DIE(aTHX_ "Can't return a %s from lvalue subroutine",
+                       SvREADONLY(TOPs) ? "readonly value" : "temporary");
                }
                else {
                    /* Can be a localized value subject to deletion. */
@@ -2446,6 +2465,8 @@ PP(pp_entersub)
            }
            if (SvGMAGICAL(sv)) {
                mg_get(sv);
+               if (SvROK(sv))
+                   goto got_rv;
                sym = SvPOKp(sv) ? SvPVX(sv) : Nullch;
            }
            else
@@ -2457,6 +2478,7 @@ PP(pp_entersub)
            cv = get_cv(sym, TRUE);
            break;
        }
+  got_rv:
        {
            SV **sp = &sv;              /* Used in tryAMAGICunDEREF macro. */
            tryAMAGICunDEREF(to_cv);
@@ -2569,7 +2591,7 @@ try_autoload:
                COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
            MgOWNER(mg) = thr;
            DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: pp_entersub lock %p\n",
-                                 thr, sv);)
+                                 thr, sv));
            MUTEX_UNLOCK(MgMUTEXP(mg));
            SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv);
        }
@@ -2653,7 +2675,7 @@ try_autoload:
            }
            DEBUG_S(if (CvDEPTH(cv) != 0)
                        PerlIO_printf(Perl_debug_log, "depth %ld != 0\n",
-                                     CvDEPTH(cv)););
+                                     CvDEPTH(cv)));
            SAVEDESTRUCTOR_X(unset_cvowner, (void*) cv);
        }
     }
@@ -2991,7 +3013,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
     HV* stash;
     char* name;
     STRLEN namelen;
-    char* packname;
+    char* packname = 0;
     STRLEN packlen;
 
     name = SvPV(meth, namelen);
@@ -3118,7 +3140,7 @@ unset_cvowner(pTHXo_ void *cvarg)
     MUTEX_LOCK(CvMUTEXP(cv));
     DEBUG_S(if (CvDEPTH(cv) != 0)
                PerlIO_printf(Perl_debug_log, "depth %ld != 0\n",
-                             CvDEPTH(cv)););
+                             CvDEPTH(cv)));
     assert(thr == CvOWNER(cv));
     CvOWNER(cv) = 0;
     MUTEX_UNLOCK(CvMUTEXP(cv));