This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to ExtUtils-CBuilder-0.15 (with a small edit to
[perl5.git] / pp_hot.c
index 5088403..72f657d 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -58,7 +58,7 @@ PP(pp_gvsv)
     if (PL_op->op_private & OPpLVAL_INTRO)
        PUSHs(save_scalar(cGVOP_gv));
     else
-       PUSHs(GvSV(cGVOP_gv));
+       PUSHs(GvSVn(cGVOP_gv));
     RETURN;
 }
 
@@ -153,7 +153,7 @@ PP(pp_concat)
 
     if (TARG == right && right != left) {
        right = sv_2mortal(newSVpvn(rpv, rlen));
-       rpv = SvPV(right, rlen);        /* no point setting UTF-8 here */
+       rpv = SvPV_const(right, rlen);  /* no point setting UTF-8 here */
        rcopied = TRUE;
     }
 
@@ -169,8 +169,7 @@ PP(pp_concat)
     }
     else { /* TARG == left */
         STRLEN llen;
-       if (SvGMAGICAL(left))
-           mg_get(left);               /* or mg_get(left) may happen here */
+       SvGETMAGIC(left);               /* or mg_get(left) may happen here */
        if (!SvOK(TARG))
            sv_setpvn(left, "", 0);
        (void)SvPV_nomg_const(left, llen);    /* Needed to set UTF8 flag */
@@ -186,7 +185,7 @@ PP(pp_concat)
            if (!rcopied)
                right = sv_2mortal(newSVpvn(rpv, rlen));
            sv_utf8_upgrade_nomg(right);
-           rpv = SvPV(right, rlen);
+           rpv = SvPV_const(right, rlen);
        }
     }
     sv_catpvn_nomg(TARG, rpv, rlen);
@@ -350,8 +349,7 @@ PP(pp_dor)
            RETURN;
        break;
     default:
-       if (SvGMAGICAL(sv))
-           mg_get(sv);
+       SvGETMAGIC(sv);
        if (SvOK(sv))
            RETURN;
     }
@@ -971,7 +969,6 @@ PP(pp_aassign)
     if (PL_op->op_private & (OPpASSIGN_COMMON)) {
        EXTEND_MORTAL(lastrelem - firstrelem + 1);
        for (relem = firstrelem; relem <= lastrelem; relem++) {
-           /*SUPPRESS 560*/
            if ((sv = *relem)) {
                TAINT_NOT;      /* Each item is independent */
                *relem = sv_mortalcopy(sv);
@@ -1202,9 +1199,9 @@ PP(pp_match)
 
     PUTBACK;                           /* EVAL blocks need stack_sp. */
     s = SvPV_const(TARG, len);
-    strend = s + len;
     if (!s)
        DIE(aTHX_ "panic: pp_match");
+    strend = s + len;
     rxtainted = ((pm->op_pmdynflags & PMdf_TAINTED) ||
                 (PL_tainted && (pm->op_pmflags & PMf_RETAINT)));
     TAINT_NOT;
@@ -1301,7 +1298,6 @@ play_it_again:
        EXTEND_MORTAL(nparens + i);
        for (i = !i; i <= nparens; i++) {
            PUSHs(sv_newmortal());
-           /*SUPPRESS 560*/
            if ((rx->startp[i] != -1) && rx->endp[i] != -1 ) {
                const I32 len = rx->endp[i] - rx->startp[i];
                s = rx->startp[i] + truebase;
@@ -1475,7 +1471,7 @@ Perl_do_readline(pTHX)
                    if (av_len(GvAVn(PL_last_in_gv)) < 0) {
                        IoFLAGS(io) &= ~IOf_START;
                        do_open(PL_last_in_gv,"-",1,FALSE,O_RDONLY,0,Nullfp);
-                       sv_setpvn(GvSV(PL_last_in_gv), "-", 1);
+                       sv_setpvn(GvSVn(PL_last_in_gv), "-", 1);
                        SvSETMAGIC(GvSV(PL_last_in_gv));
                        fp = IoIFP(io);
                        goto have_fp;
@@ -1496,8 +1492,9 @@ Perl_do_readline(pTHX)
        }
     }
     if (!fp) {
-       if (ckWARN2(WARN_GLOB, WARN_CLOSED)
-               && (!io || !(IoFLAGS(io) & IOf_START))) {
+       if ((!io || !(IoFLAGS(io) & IOf_START))
+           && ckWARN2(WARN_GLOB, WARN_CLOSED))
+       {
            if (type == OP_GLOB)
                Perl_warner(aTHX_ packWARN(WARN_GLOB),
                            "glob failed (can't start child: %s)",
@@ -1590,6 +1587,7 @@ Perl_do_readline(pTHX)
        XPUSHs(sv);
        if (type == OP_GLOB) {
            char *tmps;
+           const char *t1;
 
            if (SvCUR(sv) > 0 && SvCUR(PL_rs) > 0) {
                tmps = SvEND(sv) - 1;
@@ -1598,21 +1596,21 @@ Perl_do_readline(pTHX)
                    SvCUR_set(sv, SvCUR(sv) - 1);
                }
            }
-           for (tmps = SvPVX(sv); *tmps; tmps++)
-               if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
-                   strchr("$&*(){}[]'\";\\|?<>~`", *tmps))
+           for (t1 = SvPVX_const(sv); *t1; t1++)
+               if (!isALPHA(*t1) && !isDIGIT(*t1) &&
+                   strchr("$&*(){}[]'\";\\|?<>~`", *t1))
                        break;
-           if (*tmps && PerlLIO_lstat(SvPVX_const(sv), &PL_statbuf) < 0) {
+           if (*t1 && PerlLIO_lstat(SvPVX_const(sv), &PL_statbuf) < 0) {
                (void)POPs;             /* Unmatched wildcard?  Chuck it... */
                continue;
            }
        } else if (SvUTF8(sv)) { /* OP_READLINE, OP_RCATLINE */
-            const U8 *s = (U8*)SvPVX(sv) + offset;
+            const U8 *s = (const U8*)SvPVX_const(sv) + offset;
             const STRLEN len = SvCUR(sv) - offset;
             const U8 *f;
             
             if (ckWARN(WARN_UTF8) &&
-                !Perl_is_utf8_string_loc(aTHX_ s, len, &f))
+                   !Perl_is_utf8_string_loc(aTHX_ s, len, &f))
                  /* Emulate :encoding(utf8) warning in the same case. */
                  Perl_warner(aTHX_ packWARN(WARN_UTF8),
                              "utf8 \"\\x%02X\" does not map to Unicode",
@@ -2112,7 +2110,6 @@ PP(pp_subst)
                *m = '\0';
                SvCUR_set(TARG, m - s);
            }
-           /*SUPPRESS 560*/
            else if ((i = m - s)) {     /* faster from front */
                d -= clen;
                m = d;
@@ -2141,7 +2138,6 @@ PP(pp_subst)
                    DIE(aTHX_ "Substitution loop");
                rxtainted |= RX_MATCH_TAINTED(rx);
                m = rx->startp[0] + orig;
-               /*SUPPRESS 560*/
                if ((i = m - s)) {
                    if (s != d)
                        Move(s, d, i, char);
@@ -2198,7 +2194,7 @@ PP(pp_subst)
        if (!c) {
            register PERL_CONTEXT *cx;
            SPAGAIN;
-           ReREFCNT_inc(rx);
+           (void)ReREFCNT_inc(rx);
            PUSHSUBST(cx);
            RETURNOP(cPMOP->op_pmreplroot);
        }
@@ -2443,7 +2439,10 @@ PP(pp_leavesublv)
            MARK = newsp + 1;
            EXTEND_MORTAL(1);
            if (MARK == SP) {
-               if (SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) {
+               /* Temporaries are bad unless they happen to be elements
+                * of a tied hash or array */
+               if (SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY) &&
+                   !(SvRMAGICAL(TOPs) && mg_find(TOPs, PERL_MAGIC_tiedelem))) {
                    LEAVE;
                    cxstack_ix--;
                    POPSUB(cx,sv);
@@ -2545,7 +2544,7 @@ PP(pp_leavesublv)
 STATIC CV *
 S_get_db_sub(pTHX_ SV **svp, CV *cv)
 {
-    SV *dbsv = GvSV(PL_DBsub);
+    SV *dbsv = GvSVn(PL_DBsub);
 
     save_item(dbsv);
     if (!PERLDB_SUB_NN) {
@@ -2681,7 +2680,8 @@ PP(pp_entersub)
            PERL_STACK_OVERFLOW_CHECK();
            pad_push(padlist, CvDEPTH(cv));
        }
-       PAD_SET_CUR(padlist, CvDEPTH(cv));
+       SAVECOMPPAD();
+       PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));
        if (hasargs)
        {
            AV* av;
@@ -2800,6 +2800,7 @@ PP(pp_entersub)
        return NORMAL;
     }
 
+    /*NOTREACHED*/
     assert (0); /* Cannot get here.  */
     /* This is deliberately moved here as spaghetti code to keep it out of the
        hot path.  */
@@ -2843,7 +2844,7 @@ Perl_sub_crush_depth(pTHX_ CV *cv)
     if (CvANON(cv))
        Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on anonymous subroutine");
     else {
-       SV* tmpstr = sv_newmortal();
+       SV* const tmpstr = sv_newmortal();
        gv_efullname3(tmpstr, CvGV(cv), Nullch);
        Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%"SVf"\"",
                tmpstr);
@@ -2911,8 +2912,7 @@ PP(pp_aelem)
 void
 Perl_vivify_ref(pTHX_ SV *sv, U32 to_what)
 {
-    if (SvGMAGICAL(sv))
-       mg_get(sv);
+    SvGETMAGIC(sv);
     if (!SvOK(sv)) {
        if (SvREADONLY(sv))
            Perl_croak(aTHX_ PL_no_modify);
@@ -2942,10 +2942,10 @@ Perl_vivify_ref(pTHX_ SV *sv, U32 to_what)
 PP(pp_method)
 {
     dSP;
-    SV* sv = TOPs;
+    SV* const sv = TOPs;
 
     if (SvROK(sv)) {
-       SV* rsv = SvRV(sv);
+       SV* const rsv = SvRV(sv);
        if (SvTYPE(rsv) == SVt_PVCV) {
            SETs(rsv);
            RETURN;
@@ -2959,7 +2959,7 @@ PP(pp_method)
 PP(pp_method_named)
 {
     dSP;
-    SV* sv = cSVOP_sv;
+    SV* const sv = cSVOP_sv;
     U32 hash = SvSHARED_HASH(sv);
 
     XPUSHs(method_common(sv, &hash));
@@ -2969,31 +2969,26 @@ PP(pp_method_named)
 STATIC SV *
 S_method_common(pTHX_ SV* meth, U32* hashp)
 {
-    SV* sv;
     SV* ob;
     GV* gv;
     HV* stash;
     STRLEN namelen;
-    const char* packname = 0;
+    const char* packname = Nullch;
     SV *packsv = Nullsv;
     STRLEN packlen;
-    const char *name = SvPV_const(meth, namelen);
-
-    sv = *(PL_stack_base + TOPMARK + 1);
+    const char * const name = SvPV_const(meth, namelen);
+    SV * const sv = *(PL_stack_base + TOPMARK + 1);
 
     if (!sv)
        Perl_croak(aTHX_ "Can't call method \"%s\" on an undefined value", name);
 
-    if (SvGMAGICAL(sv))
-       mg_get(sv);
+    SvGETMAGIC(sv);
     if (SvROK(sv))
        ob = (SV*)SvRV(sv);
     else {
        GV* iogv;
 
        /* this isn't a reference */
-       packname = Nullch;
-
         if(SvOK(sv) && (packname = SvPV_const(sv, packlen))) {
           const HE* const he = hv_fetch_ent(PL_stashcache, sv, 0, 0);
           if (he) { 
@@ -3085,7 +3080,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
                packname = CopSTASHPV(PL_curcop);
            }
            else if (stash) {
-               HEK *packhek = HvNAME_HEK(stash);
+               HEK * const packhek = HvNAME_HEK(stash);
                if (packhek) {
                    packname = HEK_KEY(packhek);
                    packlen = HEK_LEN(packhek);