update Changes

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

diff --git a/op.c b/op.c
index bc07904..0cdeb92 100644 (file)
--- a/op.c
+++ b/op.c
@@ -159,7 +159,7 @@ Perl_pad_allocmy(pTHX_ char *name)
            }
        }
        if (PL_in_my == KEY_our) {
-           while (off <= top) {
+           do {
                if ((sv = svp[off])
                    && sv != &PL_sv_undef
                    && ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)
@@ -171,8 +171,7 @@ Perl_pad_allocmy(pTHX_ char *name)
                        "(Did you mean \"local\" instead of \"our\"?)\n");
                    break;
                }
-               --off;
-           }
+           } while ( off-- > 0 );
        }
     }
     off = pad_alloc(OP_PADSV, SVs_PADMY);
@@ -356,8 +355,9 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
                if (CxREALEVAL(cx))
                    saweval = i;
                break;
+           case OP_DOFILE:
            case OP_REQUIRE:
-               /* require must have its own scope */
+               /* require/do must have their own scope */
                return 0;
            }
            break;
@@ -2746,7 +2746,8 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
            SvREFCNT_dec(transv);
 
        if (!del && havefinal)
-           (void)hv_store((HV*)SvRV((cSVOPo->op_sv)), "FINAL", 5, newSViv((IV)final), 0);
+           (void)hv_store((HV*)SvRV((cSVOPo->op_sv)), "FINAL", 5,
+                          newSVuv((UV)final), 0);
 
        if (grows && to_utf)
            o->op_private |= OPpTRANS_GROWS;
@@ -4151,9 +4152,8 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside)
 
     cv = PL_compcv = (CV*)NEWSV(1104,0);
     sv_upgrade((SV *)cv, SvTYPE(proto));
+    CvFLAGS(cv) = CvFLAGS(proto) & ~CVf_CLONE;
     CvCLONED_on(cv);
-    if (CvANON(proto))
-       CvANON_on(cv);
 
 #ifdef USE_THREADS
     New(666, CvMUTEXP(cv), 1, perl_mutex);
@@ -4656,6 +4656,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
            if (!PL_checkav)
                PL_checkav = newAV();
            DEBUG_x( dump_sub(gv) );
+           if (PL_main_start && ckWARN(WARN_VOID))
+               Perl_warner(aTHX_ WARN_VOID, "Too late to run CHECK block");
            av_unshift(PL_checkav, 1);
            av_store(PL_checkav, 0, SvREFCNT_inc(cv));
            GvCV(gv) = 0;
@@ -4664,6 +4666,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
            if (!PL_initav)
                PL_initav = newAV();
            DEBUG_x( dump_sub(gv) );
+           if (PL_main_start && ckWARN(WARN_VOID))
+               Perl_warner(aTHX_ WARN_VOID, "Too late to run INIT block");
            av_push(PL_initav, SvREFCNT_inc(cv));
            GvCV(gv) = 0;
        }
@@ -4804,6 +4808,8 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
        else if (strEQ(s, "CHECK")) {
            if (!PL_checkav)
                PL_checkav = newAV();
+           if (PL_main_start && ckWARN(WARN_VOID))
+               Perl_warner(aTHX_ WARN_VOID, "Too late to run CHECK block");
            av_unshift(PL_checkav, 1);
            av_store(PL_checkav, 0, SvREFCNT_inc(cv));
            GvCV(gv) = 0;
@@ -4811,6 +4817,8 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
        else if (strEQ(s, "INIT")) {
            if (!PL_initav)
                PL_initav = newAV();
+           if (PL_main_start && ckWARN(WARN_VOID))
+               Perl_warner(aTHX_ WARN_VOID, "Too late to run INIT block");
            av_push(PL_initav, SvREFCNT_inc(cv));
            GvCV(gv) = 0;
        }
@@ -5156,6 +5164,20 @@ Perl_ck_eval(pTHX_ OP *o)
 }
 
 OP *
+Perl_ck_exit(pTHX_ OP *o)
+{
+#ifdef VMS
+    HV *table = GvHV(PL_hintgv);
+    if (table) {
+       SV **svp = hv_fetch(table, "vmsish_exit", 11, FALSE);
+       if (svp && *svp && SvTRUE(*svp))
+           o->op_private |= OPpEXIT_VMSISH;
+    }
+#endif
+    return ck_fun(o);
+}
+
+OP *
 Perl_ck_exec(pTHX_ OP *o)
 {
     OP *kid;
@@ -5835,6 +5857,36 @@ Perl_ck_null(pTHX_ OP *o)
 }
 
 OP *
+Perl_ck_open(pTHX_ OP *o)
+{
+    HV *table = GvHV(PL_hintgv);
+    if (table) {
+       SV **svp;
+       I32 mode;
+       svp = hv_fetch(table, "open_IN", 7, FALSE);
+       if (svp && *svp) {
+           mode = mode_from_discipline(*svp);
+           if (mode & O_BINARY)
+               o->op_private |= OPpOPEN_IN_RAW;
+           else if (mode & O_TEXT)
+               o->op_private |= OPpOPEN_IN_CRLF;
+       }
+
+       svp = hv_fetch(table, "open_OUT", 8, FALSE);
+       if (svp && *svp) {
+           mode = mode_from_discipline(*svp);
+           if (mode & O_BINARY)
+               o->op_private |= OPpOPEN_OUT_RAW;
+           else if (mode & O_TEXT)
+               o->op_private |= OPpOPEN_OUT_CRLF;
+       }
+    }
+    if (o->op_type == OP_BACKTICK)
+       return o;
+    return ck_fun(o);
+}
+
+OP *
 Perl_ck_repeat(pTHX_ OP *o)
 {
     if (cBINOPo->op_first->op_flags & OPf_PARENS) {
@@ -5861,7 +5913,13 @@ Perl_ck_require(pTHX_ OP *o)
                    --SvCUR(kid->op_sv);
                }
            }
-           sv_catpvn(kid->op_sv, ".pm", 3);
+           if (SvREADONLY(kid->op_sv)) {
+               SvREADONLY_off(kid->op_sv);
+               sv_catpvn(kid->op_sv, ".pm", 3);
+               SvREADONLY_on(kid->op_sv);
+           }
+           else
+               sv_catpvn(kid->op_sv, ".pm", 3);
        }
     }
     return ck_fun(o);
@@ -5956,6 +6014,12 @@ Perl_ck_sort(pTHX_ OP *o)
                    for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
                        if (k->op_next == kid)
                            k->op_next = 0;
+                       /* don't descend into loops */
+                       else if (k->op_type == OP_ENTERLOOP
+                                || k->op_type == OP_ENTERITER)
+                       {
+                           k = cLOOPx(k)->op_lastop;
+                       }
                    }
                }
                else
@@ -6353,19 +6417,16 @@ Perl_peep(pTHX_ register OP *o)
                o->op_targ = ix;
            }
 #endif
-           /* FALL THROUGH */
-       case OP_UC:
-       case OP_UCFIRST:
-       case OP_LC:
-       case OP_LCFIRST:
+           o->op_seq = PL_op_seqmax++;
+           break;
+
        case OP_CONCAT:
-       case OP_JOIN:
-       case OP_QUOTEMETA:
            if (o->op_next && o->op_next->op_type == OP_STRINGIFY) {
                if (o->op_next->op_private & OPpTARGET_MY) {
                    if (o->op_flags & OPf_STACKED) /* chained concats */
                        goto ignore_optimization;
                    else {
+                       /* assert(PL_opargs[o->op_type] & OA_TARGLEX); */
                        o->op_targ = o->op_next->op_targ;
                        o->op_next->op_targ = 0;
                        o->op_private |= OPpTARGET_MY;