[perl #39012] another REIFY bug

[p5sagit/p5-mst-13.2.git] / op.c

diff --git a/op.c b/op.c
index 86d01d4..3c44f96 100644 (file)
--- a/op.c
+++ b/op.c
@@ -509,7 +509,7 @@ S_cop_free(pTHX_ COP* cop)
        PerlMemShared_free(cop->cop_warnings);
     if (! specialCopIO(cop->cop_io)) {
 #ifdef USE_ITHREADS
-       /*EMPTY*/
+       NOOP;
 #else
        SvREFCNT_dec(cop->cop_io);
 #endif
@@ -1649,7 +1649,7 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my)
        /* Don't force the C<use> if we don't need it. */
        SV * const * const svp = hv_fetchs(GvHVn(PL_incgv), ATTRSMODULE_PM, FALSE);
        if (svp && *svp != &PL_sv_undef)
-           /*EMPTY*/;          /* already in %INC */
+           NOOP;       /* already in %INC */
        else
            Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
                             newSVpvs(ATTRSMODULE), NULL);
@@ -2013,7 +2013,7 @@ STATIC OP *
 S_newDEFSVOP(pTHX)
 {
     dVAR;
-    const I32 offset = pad_findmy("$_");
+    const PADOFFSET offset = pad_findmy("$_");
     if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(offset)) {
        return newSVREF(newGVOP(OP_GV, 0, PL_defgv));
     }
@@ -2080,7 +2080,7 @@ Perl_localize(pTHX_ OP *o, I32 lex)
 #if 0
        list(o);
 #else
-       /*EMPTY*/;
+       NOOP;
 #endif
     else {
        if ( PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ','
@@ -3315,7 +3315,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
                        repl_has_vars = 1;
                    }
                    else if (curop->op_type == OP_PUSHRE)
-                       /*EMPTY*/; /* Okay here, dangerous in newASSIGNOP */
+                       NOOP; /* Okay here, dangerous in newASSIGNOP */
                    else
                        break;
                }
@@ -4476,7 +4476,7 @@ Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP
            iterpflags |= OPpITER_DEF;
     }
     else {
-        const I32 offset = pad_findmy("$_");
+        const PADOFFSET offset = pad_findmy("$_");
        if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(offset)) {
            sv = newGVOP(OP_GV, 0, PL_defgv);
        }
@@ -5399,13 +5399,13 @@ Perl_newCONSTSUB(pTHX_ HV *stash, const char *name, SV *sv)
     CV* cv;
 #ifdef USE_ITHREADS
     const char *const temp_p = CopFILE(PL_curcop);
-    const STRLEN len = strlen(temp_p);
+    const STRLEN len = temp_p ? strlen(temp_p) : 0;
 #else
     SV *const temp_sv = CopFILESV(PL_curcop);
     STRLEN len;
     const char *const temp_p = temp_sv ? SvPV_const(temp_sv, len) : NULL;
 #endif
-    char *const file = temp_p ? savepvn(temp_p, len) : NULL;
+    char *const file = savepvn(temp_p, temp_p ? len : 0);
 
     ENTER;
 
@@ -6150,7 +6150,7 @@ Perl_ck_ftst(pTHX_ OP *o)
     const I32 type = o->op_type;
 
     if (o->op_flags & OPf_REF) {
-       /*EMPTY*/;
+       NOOP;
     }
     else if (o->op_flags & OPf_KIDS && cUNOPo->op_first->op_type != OP_STUB) {
        SVOP * const kid = (SVOP*)cUNOPo->op_first;
@@ -6528,7 +6528,7 @@ Perl_ck_grep(pTHX_ OP *o)
     LOGOP *gwop = NULL;
     OP *kid;
     const OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
-    I32 offset;
+    PADOFFSET offset;
 
     o->op_ppaddr = PL_ppaddr[OP_GREPSTART];
     /* don't allocate gwop here, as we may leak it if PL_error_count > 0 */
@@ -6766,7 +6766,7 @@ Perl_ck_match(pTHX_ OP *o)
 {
     dVAR;
     if (o->op_type != OP_QR && PL_compcv) {
-       const I32 offset = pad_findmy("$_");
+       const PADOFFSET offset = pad_findmy("$_");
        if (offset != NOT_IN_PAD && !(PAD_COMPNAME_FLAGS_isOUR(offset))) {
            o->op_targ = offset;
            o->op_private |= OPpTARGET_MY;
@@ -7231,7 +7231,7 @@ Perl_ck_subr(pTHX_ OP *o)
             ? cUNOPo : ((UNOP*)cUNOPo->op_first))->op_first;
     OP *o2 = prev->op_sibling;
     OP *cvop;
-    char *proto = NULL;
+    const char *proto = NULL;
     const char *proto_end = NULL;
     CV *cv = NULL;
     GV *namegv = NULL;
@@ -7381,15 +7381,13 @@ Perl_ck_subr(pTHX_ OP *o)
                     break;
                case ']':
                     if (contextclass) {
-                        /* XXX We shouldn't be modifying proto, so we can const proto */
-                        char *p = proto;
-                        const char s = *p;
+                        const char *p = proto;
+                        const char *const end = proto;
                         contextclass = 0;
-                        *p = '\0';
                         while (*--p != '[');
-                        bad_type(arg, Perl_form(aTHX_ "one of %s", p),
-                                gv_ename(namegv), o3);
-                        *proto = s;
+                        bad_type(arg, Perl_form(aTHX_ "one of %.*s",
+                                                (int)(end - p), p),
+                                 gv_ename(namegv), o3);
                     } else
                          goto oops;
                     break;
@@ -7822,7 +7820,7 @@ Perl_peep(pTHX_ register OP *o)
            if ((!SvFAKE(sv = *svp) || !SvREADONLY(sv)) && !IS_PADCONST(sv)) {
                key = SvPV_const(sv, keylen);
                lexname = newSVpvn_share(key,
-                                        SvUTF8(sv) ? -(I32)keylen : keylen,
+                                        SvUTF8(sv) ? -(I32)keylen : (I32)keylen,
                                         0);
                SvREFCNT_dec(sv);
                *svp = lexname;
@@ -7842,7 +7840,7 @@ Perl_peep(pTHX_ register OP *o)
                break;
            key = SvPV_const(*svp, keylen);
            if (!hv_fetch(GvHV(*fields), key,
-                       SvUTF8(*svp) ? -(I32)keylen : keylen, FALSE))
+                       SvUTF8(*svp) ? -(I32)keylen : (I32)keylen, FALSE))
            {
                Perl_croak(aTHX_ "No such class field \"%s\" " 
                           "in variable %s of type %s", 
@@ -7899,7 +7897,7 @@ Perl_peep(pTHX_ register OP *o)
                svp = cSVOPx_svp(key_op);
                key = SvPV_const(*svp, keylen);
                if (!hv_fetch(GvHV(*fields), key, 
-                           SvUTF8(*svp) ? -(I32)keylen : keylen, FALSE))
+                           SvUTF8(*svp) ? -(I32)keylen : (I32)keylen, FALSE))
                {
                    Perl_croak(aTHX_ "No such class field \"%s\" "
                               "in variable %s of type %s",
@@ -8228,7 +8226,7 @@ const_sv_xsub(pTHX_ CV* cv)
     dVAR;
     dXSARGS;
     if (items != 0) {
-       /*EMPTY*/;
+       NOOP;
 #if 0
         Perl_croak(aTHX_ "usage: %s::%s()",
                    HvNAME_get(GvSTASH(CvGV(cv))), GvNAME(CvGV(cv)));