use &dl_error rather than &dl_load_file as the guard for calling

[perl5.git] / op.c

diff --git a/op.c b/op.c
index 3d70756..64b8006 100644 (file)
--- a/op.c
+++ b/op.c
@@ -168,7 +168,7 @@ Perl_pad_allocmy(pTHX_ char *name)
                    Perl_warner(aTHX_ WARN_MISC,
                        "\"our\" variable %s redeclared", name);
                    Perl_warner(aTHX_ WARN_MISC,
-                       "(Did you mean \"local\" instead of \"our\"?)\n");
+                       "\t(Did you mean \"local\" instead of \"our\"?)\n");
                    break;
                }
            } while ( off-- > 0 );
@@ -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;
@@ -3847,7 +3848,10 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *
        loopflags |= OPpLOOP_CONTINUE;
     }
     if (expr) {
-       cont = append_elem(OP_LINESEQ, cont, newOP(OP_UNSTACK, 0));
+       OP *unstack = newOP(OP_UNSTACK, 0);
+       if (!next)
+           next = unstack;
+       cont = append_elem(OP_LINESEQ, cont, unstack);
        if ((line_t)whileline != NOLINE) {
            PL_copline = whileline;
            cont = append_elem(OP_LINESEQ, cont,
@@ -3870,8 +3874,6 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *
        if (listop)
            ((LISTOP*)listop)->op_last->op_next = condop =
                (o == listop ? redo : LINKLIST(o));
-       if (!next)
-           next = condop;
     }
     else
        o = listop;
@@ -4151,9 +4153,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 +4657,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 +4667,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 +4809,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 +4818,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 +5165,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;
@@ -5498,6 +5521,13 @@ Perl_ck_fun(pTHX_ OP *o)
                                name = GvNAME(gv);
                                len = GvNAMELEN(gv);
                            }
+                           else if (kid->op_type == OP_AELEM
+                                    || kid->op_type == OP_HELEM)
+                           {
+                               name = "__ANONIO__";
+                               len = 10;
+                               mod(kid,type);
+                           }
                            if (name) {
                                SV *namesv;
                                targ = pad_alloc(OP_RV2GV, SVs_PADTMP);
@@ -5682,7 +5712,7 @@ Perl_ck_defined(pTHX_ OP *o)              /* 19990527 MJD */
            Perl_warner(aTHX_ WARN_DEPRECATED,
                        "defined(@array) is deprecated");
            Perl_warner(aTHX_ WARN_DEPRECATED,
-                       "(Maybe you should just omit the defined()?)\n");
+                       "\t(Maybe you should just omit the defined()?)\n");
        break;
        case OP_RV2HV:
            break;                      /* Globals via GV can be undef */ 
@@ -5690,7 +5720,7 @@ Perl_ck_defined(pTHX_ OP *o)              /* 19990527 MJD */
            Perl_warner(aTHX_ WARN_DEPRECATED,
                        "defined(%%hash) is deprecated");
            Perl_warner(aTHX_ WARN_DEPRECATED,
-                       "(Maybe you should just omit the defined()?)\n");
+                       "\t(Maybe you should just omit the defined()?)\n");
            break;
        default:
            /* no warning */
@@ -5992,6 +6022,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
@@ -6527,7 +6563,7 @@ Perl_peep(pTHX_ register OP *o)
                    Perl_warner(aTHX_ WARN_EXEC,
                                "Statement unlikely to be reached");
                    Perl_warner(aTHX_ WARN_EXEC,
-                               "(Maybe you meant system() when you said exec()?)\n");
+                               "\t(Maybe you meant system() when you said exec()?)\n");
                    CopLINE_set(PL_curcop, oldline);
                }
            }