This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Too many 64-bitness option combinations.
[perl5.git] / op.c
diff --git a/op.c b/op.c
index 32eb7b0..ed5a7eb 100644 (file)
--- a/op.c
+++ b/op.c
@@ -151,7 +151,7 @@ Perl_pad_allocmy(pTHX_ char *name)
        }
        yyerror(Perl_form(aTHX_ "Can't use global %s in \"my\"",name));
     }
-    if (ckWARN(WARN_UNSAFE) && AvFILLp(PL_comppad_name) >= 0) {
+    if (ckWARN(WARN_MISC) && AvFILLp(PL_comppad_name) >= 0) {
        SV **svp = AvARRAY(PL_comppad_name);
        HV *ourstash = (PL_curstash ? PL_curstash : PL_defstash);
        PADOFFSET top = AvFILLp(PL_comppad_name);
@@ -163,7 +163,7 @@ Perl_pad_allocmy(pTHX_ char *name)
                    || ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash))
                && strEQ(name, SvPVX(sv)))
            {
-               Perl_warner(aTHX_ WARN_UNSAFE,
+               Perl_warner(aTHX_ WARN_MISC,
                    "\"%s\" variable %s masks earlier declaration in same %s", 
                    (PL_in_my == KEY_our ? "our" : "my"),
                    name,
@@ -179,9 +179,9 @@ Perl_pad_allocmy(pTHX_ char *name)
                    && ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)
                    && strEQ(name, SvPVX(sv)))
                {
-                   Perl_warner(aTHX_ WARN_UNSAFE,
+                   Perl_warner(aTHX_ WARN_MISC,
                        "\"our\" variable %s redeclared", name);
-                   Perl_warner(aTHX_ WARN_UNSAFE,
+                   Perl_warner(aTHX_ WARN_MISC,
                        "(Did you mean \"local\" instead of \"our\"?)\n");
                    break;
                }
@@ -204,7 +204,7 @@ Perl_pad_allocmy(pTHX_ char *name)
     }
     if (PL_in_my == KEY_our) {
        (void)SvUPGRADE(sv, SVt_PVGV);
-       GvSTASH(sv) = (HV*)SvREFCNT_inc(PL_curstash ? PL_curstash : PL_defstash);
+       GvSTASH(sv) = (HV*)SvREFCNT_inc(PL_curstash ? (SV*)PL_curstash : (SV*)PL_defstash);
        SvFLAGS(sv) |= SVpad_OUR;
     }
     av_store(PL_comppad_name, off, sv);
@@ -1412,18 +1412,19 @@ Perl_mod(pTHX_ OP *o, I32 type)
                    if (kid->op_type == OP_METHOD_NAMED
                        || kid->op_type == OP_METHOD)
                    {
-                       OP *newop;
+                       UNOP *newop;
 
                        if (kid->op_sibling || kid->op_next != kid) {
                            yyerror("panic: unexpected optree near method call");
                            break;
                        }
                        
-                       NewOp(1101, newop, 1, OP);
+                       NewOp(1101, newop, 1, UNOP);
                        newop->op_type = OP_RV2CV;
                        newop->op_ppaddr = PL_ppaddr[OP_RV2CV];
-                       newop->op_next = newop;
-                       kid->op_sibling = newop;
+                       newop->op_first = Nullop;
+                        newop->op_next = (OP*)newop;
+                       kid->op_sibling = (OP*)newop;
                        newop->op_private |= OPpLVAL_INTRO;
                        break;
                    }
@@ -1946,7 +1947,7 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
     dTHR;
     OP *o;
 
-    if (ckWARN(WARN_UNSAFE) &&
+    if (ckWARN(WARN_MISC) &&
       (left->op_type == OP_RV2AV ||
        left->op_type == OP_RV2HV ||
        left->op_type == OP_PADAV ||
@@ -1957,7 +1958,7 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
       const char *sample = ((left->op_type == OP_RV2AV ||
                             left->op_type == OP_PADAV)
                            ? "@array" : "%hash");
-      Perl_warner(aTHX_ WARN_UNSAFE,
+      Perl_warner(aTHX_ WARN_MISC,
              "Applying %s to %s will act on scalar(%s)", 
              desc, sample, sample);
     }
@@ -2606,7 +2607,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
        I32 to_utf      = o->op_private & OPpTRANS_TO_UTF;
 
        if (complement) {
-           U8 tmpbuf[10];
+           U8 tmpbuf[UTF8_MAXLEN];
            U8** cp;
            UV nextmin = 0;
            New(1109, cp, tlen, U8*);
@@ -3108,14 +3109,14 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
     if (version != Nullop) {
        SV *vesv = ((SVOP*)version)->op_sv;
 
-       if (arg == Nullop && !SvNIOK(vesv)) {
+       if (arg == Nullop && !SvNIOKp(vesv)) {
            arg = version;
        }
        else {
            OP *pack;
            SV *meth;
 
-           if (version->op_type != OP_CONST || !SvNIOK(vesv))
+           if (version->op_type != OP_CONST || !SvNIOKp(vesv))
                Perl_croak(aTHX_ "Version number must be constant number");
 
            /* Make copy of id so we don't free it twice */
@@ -3136,7 +3137,7 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
     /* Fake up an import/unimport */
     if (arg && arg->op_type == OP_STUB)
        imop = arg;             /* no import on explicit () */
-    else if (SvNIOK(((SVOP*)id)->op_sv)) {
+    else if (SvNIOKp(((SVOP*)id)->op_sv)) {
        imop = Nullop;          /* use 5.0; */
     }
     else {
@@ -3515,7 +3516,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
     }
     if (first->op_type == OP_CONST) {
        if (ckWARN(WARN_BAREWORD) && (first->op_private & OPpCONST_BARE))
-           Perl_warner(aTHX_ WARN_BAREWORD, "Bareword found in conditional");
+           Perl_warner(aTHX_ WARN_BAREWORD, "Bareword found in conditional"); 
        if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
            op_free(first);
            *firstp = Nullop;
@@ -3533,7 +3534,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
        else
            scalar(other);
     }
-    else if (ckWARN(WARN_UNSAFE) && (first->op_flags & OPf_KIDS)) {
+    else if (ckWARN(WARN_MISC) && (first->op_flags & OPf_KIDS)) {
        OP *k1 = ((UNOP*)first)->op_first;
        OP *k2 = k1->op_sibling;
        OPCODE warnop = 0;
@@ -3562,7 +3563,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
        if (warnop) {
            line_t oldline = CopLINE(PL_curcop);
            CopLINE_set(PL_curcop, PL_copline);
-           Perl_warner(aTHX_ WARN_UNSAFE,
+           Perl_warner(aTHX_ WARN_MISC,
                 "Value of %s%s can be \"0\"; test with defined()",
                 PL_op_desc[warnop],
                 ((warnop == OP_READLINE || warnop == OP_GLOB)
@@ -3763,6 +3764,7 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *
     OP *listop;
     OP *o;
     OP *condop;
+    U8 loopflags = 0;
 
     if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
                 || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB))) {
@@ -3795,8 +3797,10 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *
        block = scope(block);
     }
 
-    if (cont)
+    if (cont) {
        next = LINKLIST(cont);
+       loopflags |= OPpLOOP_CONTINUE;
+    }
     if (expr) {
        cont = append_elem(OP_LINESEQ, cont, newOP(OP_UNSTACK, 0));
        if ((line_t)whileline != NOLINE) {
@@ -3839,6 +3843,7 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *
 
     loop->op_redoop = redo;
     loop->op_lastop = o;
+    o->op_private |= loopflags;
 
     if (next)
        loop->op_nextop = next;
@@ -4223,7 +4228,7 @@ Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p)
 {
     dTHR;
 
-    if (((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) && ckWARN_d(WARN_UNSAFE)) {
+    if (((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) && ckWARN_d(WARN_PROTOTYPE)) {
        SV* msg = sv_newmortal();
        SV* name = Nullsv;
 
@@ -4239,7 +4244,7 @@ Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p)
            Perl_sv_catpvf(aTHX_ msg, "(%s)", p);
        else
            sv_catpv(msg, "none");
-       Perl_warner(aTHX_ WARN_UNSAFE, "%"SVf, msg);
+       Perl_warner(aTHX_ WARN_PROTOTYPE, "%"SVf, msg);
     }
 }
 
@@ -4345,9 +4350,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                                           maximum a prototype before. */
        if (SvTYPE(gv) > SVt_NULL) {
            if (!SvPOK((SV*)gv) && !(SvIOK((SV*)gv) && SvIVX((SV*)gv) == -1)
-               && ckWARN_d(WARN_UNSAFE))
+               && ckWARN_d(WARN_PROTOTYPE))
            {
-               Perl_warner(aTHX_ WARN_UNSAFE, "Runaway prototype");
+               Perl_warner(aTHX_ WARN_PROTOTYPE, "Runaway prototype");
            }
            cv_ckproto((CV*)gv, NULL, ps);
        }
@@ -4381,11 +4386,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                goto withattrs;
            if (const_sv = cv_const_sv(cv))
                const_changed = sv_cmp(const_sv, op_const_sv(block, Nullcv));
-           if ((const_sv && const_changed) || ckWARN(WARN_REDEFINE) 
-                                       && !(CvGV(cv) && GvSTASH(CvGV(cv))
-                                       && HvNAME(GvSTASH(CvGV(cv)))
-                                       && strEQ(HvNAME(GvSTASH(CvGV(cv))),
-                                                "autouse")))
+           if ((const_sv || const_changed) && ckWARN(WARN_REDEFINE))
            {
                line_t oldline = CopLINE(PL_curcop);
                CopLINE_set(PL_curcop, PL_copline);
@@ -5363,8 +5364,8 @@ Perl_ck_fun(pTHX_ OP *o)
                    char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
                    OP *newop = newAVREF(newGVOP(OP_GV, 0,
                        gv_fetchpv(name, TRUE, SVt_PVAV) ));
-                   if (ckWARN(WARN_SYNTAX))
-                       Perl_warner(aTHX_ WARN_SYNTAX,
+                   if (ckWARN(WARN_DEPRECATED))
+                       Perl_warner(aTHX_ WARN_DEPRECATED,
                            "Array @%s missing the @ in argument %"IVdf" of %s()",
                            name, (IV)numargs, PL_op_desc[type]);
                    op_free(kid);
@@ -5383,8 +5384,8 @@ Perl_ck_fun(pTHX_ OP *o)
                    char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
                    OP *newop = newHVREF(newGVOP(OP_GV, 0,
                        gv_fetchpv(name, TRUE, SVt_PVHV) ));
-                   if (ckWARN(WARN_SYNTAX))
-                       Perl_warner(aTHX_ WARN_SYNTAX,
+                   if (ckWARN(WARN_DEPRECATED))
+                       Perl_warner(aTHX_ WARN_DEPRECATED,
                            "Hash %%%s missing the %% in argument %"IVdf" of %s()",
                            name, (IV)numargs, PL_op_desc[type]);
                    op_free(kid);
@@ -5503,6 +5504,7 @@ Perl_ck_glob(pTHX_ OP *o)
 {
     GV *gv;
 
+    o = ck_fun(o);
     if ((o->op_flags & OPf_KIDS) && !cLISTOPo->op_first->op_sibling)
        append_elem(OP_GLOB, o, newDEFSVOP());
 
@@ -5541,7 +5543,7 @@ Perl_ck_glob(pTHX_ OP *o)
     gv_IOadd(gv);
     append_elem(OP_GLOB, o, newGVOP(OP_GV, 0, gv));
     scalarkids(o);
-    return ck_fun(o);
+    return o;
 }
 
 OP *
@@ -6390,13 +6392,13 @@ Perl_peep(pTHX_ register OP *o)
                    GvAVn(gv);
                }
            }
-           else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_UNSAFE)) {
+           else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_PROTOTYPE)) {
                GV *gv = cGVOPo_gv;
                if (SvTYPE(gv) == SVt_PVGV && GvCV(gv) && SvPVX(GvCV(gv))) {
                    /* XXX could check prototype here instead of just carping */
                    SV *sv = sv_newmortal();
                    gv_efullname3(sv, gv, Nullch);
-                   Perl_warner(aTHX_ WARN_UNSAFE,
+                   Perl_warner(aTHX_ WARN_PROTOTYPE,
                                "%s() called too early to check prototype",
                                SvPV_nolen(sv));
                }