Upgrade to Pod-Simple-3.04
[p5sagit/p5-mst-13.2.git] / op.c
diff --git a/op.c b/op.c
index baf207f..966cf84 100644 (file)
--- a/op.c
+++ b/op.c
@@ -792,9 +792,10 @@ Perl_scalarvoid(pTHX_ OP *o)
                      built upon these three nroff macros being used in
                      void context. The pink camel has the details in
                      the script wrapman near page 319. */
-                   if (strnEQ(SvPVX_const(sv), "di", 2) ||
-                       strnEQ(SvPVX_const(sv), "ds", 2) ||
-                       strnEQ(SvPVX_const(sv), "ig", 2))
+                   const char * const maybe_macro = SvPVX_const(sv);
+                   if (strnEQ(maybe_macro, "di", 2) ||
+                       strnEQ(maybe_macro, "ds", 2) ||
+                       strnEQ(maybe_macro, "ig", 2))
                            useless = 0;
                }
            }
@@ -1036,6 +1037,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
     case OP_CONST:
        if (!(o->op_private & (OPpCONST_ARYBASE)))
            goto nomod;
+       localize = 0;
        if (PL_eval_start && PL_eval_start->op_type == OP_CONST) {
            PL_compiling.cop_arybase = (I32)SvIV(cSVOPx(PL_eval_start)->op_sv);
            PL_eval_start = 0;
@@ -1155,9 +1157,8 @@ Perl_mod(pTHX_ OP *o, I32 type)
        /* FALL THROUGH */
     default:
       nomod:
-       /* grep, foreach, subcalls, refgen, m//g */
-       if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN
-           || type == OP_MATCH)
+       /* grep, foreach, subcalls, refgen */
+       if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)
            break;
        yyerror(Perl_form(aTHX_ "Can't modify %s in %s",
                     (o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL)
@@ -1577,19 +1578,17 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my)
 
     if (for_my) {
        /* Don't force the C<use> if we don't need it. */
-       SV * const * const svp = hv_fetch(GvHVn(PL_incgv), ATTRSMODULE_PM,
-                      sizeof(ATTRSMODULE_PM)-1, 0);
+       SV * const * const svp = hv_fetchs(GvHVn(PL_incgv), ATTRSMODULE_PM, FALSE);
        if (svp && *svp != &PL_sv_undef)
            ;           /* already in %INC */
        else
            Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
-                            newSVpvn(ATTRSMODULE, sizeof(ATTRSMODULE)-1),
-                            Nullsv);
+                            newSVpvs(ATTRSMODULE), NULL);
     }
     else {
        Perl_load_module(aTHX_ PERL_LOADMOD_IMPORT_OPS,
-                        newSVpvn(ATTRSMODULE, sizeof(ATTRSMODULE)-1),
-                        Nullsv,
+                        newSVpvs(ATTRSMODULE),
+                        NULL,
                         prepend_elem(OP_LIST,
                                      newSVOP(OP_CONST, 0, stashsv),
                                      prepend_elem(OP_LIST,
@@ -1618,7 +1617,7 @@ S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp)
     apply_attrs(stash, PAD_SV(target->op_targ), attrs, TRUE);
 
     /* Need package name for method call. */
-    pack = newSVOP(OP_CONST, 0, newSVpvn(ATTRSMODULE, sizeof(ATTRSMODULE)-1));
+    pack = newSVOP(OP_CONST, 0, newSVpvs(ATTRSMODULE));
 
     /* Build up the real arg-list. */
     stashsv = stash ? newSVhek(HvNAME_HEK(stash)) : &PL_sv_no;
@@ -1683,7 +1682,7 @@ Perl_apply_attrs_string(pTHX_ const char *stashpv, CV *cv,
     }
 
     Perl_load_module(aTHX_ PERL_LOADMOD_IMPORT_OPS,
-                     newSVpvn(ATTRSMODULE, sizeof(ATTRSMODULE)-1),
+                    newSVpvs(ATTRSMODULE),
                      Nullsv, prepend_elem(OP_LIST,
                                  newSVOP(OP_CONST, 0, newSVpv(stashpv,0)),
                                  prepend_elem(OP_LIST,
@@ -1841,14 +1840,9 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
     }
     if (!(right->op_flags & OPf_STACKED) && ismatchop) {
        right->op_flags |= OPf_STACKED;
-       /* s/// and tr/// modify their arg.
-        * m//g also indirectly modifies the arg by setting pos magic on it */
-       if (   (right->op_type == OP_MATCH &&
-                   (cPMOPx(right)->op_pmflags & PMf_GLOBAL))
-           || (right->op_type == OP_SUBST)
-           || (right->op_type == OP_TRANS &&
-               ! (right->op_private & OPpTRANS_IDENTICAL))
-       )
+       if (right->op_type != OP_MATCH &&
+            ! (right->op_type == OP_TRANS &&
+               right->op_private & OPpTRANS_IDENTICAL))
            left = mod(left, right->op_type);
        if (right->op_type == OP_TRANS)
            o = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
@@ -2056,8 +2050,7 @@ OP *
 Perl_jmaybe(pTHX_ OP *o)
 {
     if (o->op_type == OP_LIST) {
-       OP *o2;
-       o2 = newSVREF(newGVOP(OP_GV, 0, gv_fetchpv(";", GV_ADD, SVt_PV))),
+       OP * const o2 = newSVREF(newGVOP(OP_GV, 0, gv_fetchpv(";", GV_ADD, SVt_PV)));
        o = convert(OP_JOIN, 0, prepend_elem(OP_LIST, o2, o));
     }
     return o;
@@ -2828,7 +2821,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
 
     if (expr->op_type == OP_CONST) {
        STRLEN plen;
-       SV *pat = ((SVOP*)expr)->op_sv;
+       SV * const pat = ((SVOP*)expr)->op_sv;
        const char *p = SvPV_const(pat, plen);
        if ((o->op_flags & OPf_SPECIAL) && (*p == ' ' && p[1] == '\0')) {
            U32 was_readonly = SvREADONLY(pat);
@@ -2896,7 +2889,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
     if (repl) {
        OP *curop;
        if (pm->op_pmflags & PMf_EVAL) {
-           curop = 0;
+           curop = NULL;
            if (CopLINE(PL_curcop) < (line_t)PL_multi_end)
                CopLINE_set(PL_curcop, (line_t)PL_multi_end);
        }
@@ -2907,7 +2900,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
            for (curop = LINKLIST(repl); curop!=repl; curop = LINKLIST(curop)) {
                if (PL_opargs[curop->op_type] & OA_DANGEROUS) {
                    if (curop->op_type == OP_GV) {
-                       GV *gv = cGVOPx_gv(curop);
+                       GV * const gv = cGVOPx_gv(curop);
                        repl_has_vars = 1;
                        if (strchr("&`'123456789+-\016\022", *GvENAME(gv)))
                            break;
@@ -3243,7 +3236,7 @@ Perl_dofile(pTHX_ OP *term, I32 force_builtin)
     if (!force_builtin) {
        gv = gv_fetchpv("do", 0, SVt_PVCV);
        if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv))) {
-           GV * const * const gvp = (GV**)hv_fetch(PL_globalstash, "do", 2, FALSE);
+           GV * const * const gvp = (GV**)hv_fetchs(PL_globalstash, "do", FALSE);
            gv = gvp ? *gvp : Nullgv;
        }
     }
@@ -4725,7 +4718,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        const char * const tname = (name ? name : aname);
 
        if (PERLDB_SUBLINE && PL_curstash != PL_debstash) {
-           SV * const sv = NEWSV(0,0);
+           SV * const sv = newSV(0);
            SV * const tmpstr = sv_newmortal();
            GV * const db_postponed = gv_fetchpv("DB::postponed", GV_ADDMULTI, SVt_PVHV);
            HV *hv;
@@ -4909,7 +4902,7 @@ Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename)
     if (cv)                            /* must reuse cv if autoloaded */
        cv_undef(cv);
     else {
-       cv = (CV*)NEWSV(1105,0);
+       cv = (CV*)newSV(0);
        sv_upgrade((SV *)cv, SVt_PVCV);
        if (name) {
            GvCV(gv) = cv;
@@ -5350,7 +5343,7 @@ Perl_ck_exit(pTHX_ OP *o)
 #ifdef VMS
     HV * const table = GvHV(PL_hintgv);
     if (table) {
-       SV * const * const svp = hv_fetch(table, "vmsish_exit", 11, FALSE);
+       SV * const * const svp = hv_fetchs(table, "vmsish_exit", FALSE);
        if (svp && *svp && SvTRUE(*svp))
            o->op_private |= OPpEXIT_VMSISH;
     }
@@ -5707,7 +5700,7 @@ Perl_ck_fun(pTHX_ OP *o)
                                     || kid->op_type == OP_HELEM)
                            {
                                 OP *op = ((BINOP*)kid)->op_first;
-                                name = 0;
+                                name = NULL;
                                 if (op) {
                                      SV *tmpstr = Nullsv;
                                      const char * const a =
@@ -6105,10 +6098,11 @@ Perl_ck_method(pTHX_ OP *o)
     OP * const kid = cUNOPo->op_first;
     if (kid->op_type == OP_CONST) {
        SV* sv = kSVOP->op_sv;
-       if (!(strchr(SvPVX_const(sv), ':') || strchr(SvPVX_const(sv), '\''))) {
+       const char * const method = SvPVX_const(sv);
+       if (!(strchr(method, ':') || strchr(method, '\''))) {
            OP *cmop;
            if (!SvREADONLY(sv) || !SvFAKE(sv)) {
-               sv = newSVpvn_share(SvPVX_const(sv), SvCUR(sv), 0);
+               sv = newSVpvn_share(method, SvCUR(sv), 0);
            }
            else {
                kSVOP->op_sv = Nullsv;
@@ -6133,7 +6127,7 @@ Perl_ck_open(pTHX_ OP *o)
     dVAR;
     HV * const table = GvHV(PL_hintgv);
     if (table) {
-       SV **svp = hv_fetch(table, "open_IN", 7, FALSE);
+       SV **svp = hv_fetchs(table, "open_IN", FALSE);
        if (svp && *svp) {
            const I32 mode = mode_from_discipline(*svp);
            if (mode & O_BINARY)
@@ -6142,7 +6136,7 @@ Perl_ck_open(pTHX_ OP *o)
                o->op_private |= OPpOPEN_IN_CRLF;
        }
 
-       svp = hv_fetch(table, "open_OUT", 8, FALSE);
+       svp = hv_fetchs(table, "open_OUT", FALSE);
        if (svp && *svp) {
            const I32 mode = mode_from_discipline(*svp);
            if (mode & O_BINARY)
@@ -6229,7 +6223,7 @@ Perl_ck_require(pTHX_ OP *o)
        /* handle override, if any */
        gv = gv_fetchpv("require", 0, SVt_PVCV);
        if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv))) {
-           GV * const * const gvp = (GV**)hv_fetch(PL_globalstash, "require", 7, FALSE);
+           GV * const * const gvp = (GV**)hv_fetchs(PL_globalstash, "require", FALSE);
            gv = gvp ? *gvp : Nullgv;
        }
     }
@@ -6306,11 +6300,11 @@ Perl_ck_sort(pTHX_ OP *o)
 
     if (o->op_type == OP_SORT && (PL_hints & HINT_LOCALIZE_HH) != 0)
     {
-       HV *hinthv = GvHV(PL_hintgv);
+       HV * const hinthv = GvHV(PL_hintgv);
        if (hinthv) {
-           SV **svp = hv_fetch(hinthv, "sort", 4, 0);
+           SV ** const svp = hv_fetchs(hinthv, "sort", FALSE);
            if (svp) {
-               I32 sorthints = (I32)SvIV(*svp);
+               const I32 sorthints = (I32)SvIV(*svp);
                if ((sorthints & HINT_SORT_QUICKSORT) != 0)
                    o->op_private |= OPpSORT_QSORT;
                if ((sorthints & HINT_SORT_STABLE) != 0)
@@ -7097,7 +7091,7 @@ Perl_peep(pTHX_ register OP *o)
            lexname = *av_fetch(PL_comppad_name, rop->op_first->op_targ, TRUE);
            if (!(SvFLAGS(lexname) & SVpad_TYPED))
                break;
-           fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
+           fields = (GV**)hv_fetchs(SvSTASH(lexname), "FIELDS", FALSE);
            if (!fields || !GvHV(*fields))
                break;
            key = SvPV_const(*svp, keylen);
@@ -7146,7 +7140,7 @@ Perl_peep(pTHX_ register OP *o)
            lexname = *av_fetch(PL_comppad_name, rop->op_targ, TRUE);
            if (!(SvFLAGS(lexname) & SVpad_TYPED))
                break;
-           fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
+           fields = (GV**)hv_fetchs(SvSTASH(lexname), "FIELDS", FALSE);
            if (!fields || !GvHV(*fields))
                break;
            /* Again guessing that the pushmark can be jumped over.... */