Integrate with Sarathy.

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

diff --git a/op.c b/op.c
index 81df30e..eb4a0ed 100644 (file)
--- a/op.c
+++ b/op.c
@@ -414,13 +414,14 @@ Perl_pad_findmy(pTHX_ char *name)
 void
 Perl_pad_leavemy(pTHX_ I32 fill)
 {
+    dTHR;
     I32 off;
     SV **svp = AvARRAY(PL_comppad_name);
     SV *sv;
     if (PL_min_intro_pending && fill < PL_min_intro_pending) {
        for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
-           if ((sv = svp[off]) && sv != &PL_sv_undef)
-               Perl_warn(aTHX_ "%s never introduced", SvPVX(sv));
+           if ((sv = svp[off]) && sv != &PL_sv_undef && ckWARN_d(WARN_INTERNAL))
+               Perl_warner(aTHX_ WARN_INTERNAL, "%s never introduced", SvPVX(sv));
        }
     }
     /* "Deintroduce" my variables that are leaving with this scope. */
@@ -731,7 +732,7 @@ S_cop_free(pTHX_ COP* cop)
 {
     Safefree(cop->cop_label);
     SvREFCNT_dec(cop->cop_filegv);
-    if (cop->cop_warnings != WARN_NONE && cop->cop_warnings != WARN_ALL)
+    if (! specialWARN(cop->cop_warnings))
        SvREFCNT_dec(cop->cop_warnings);
 }
 
@@ -1727,8 +1728,7 @@ Perl_block_start(pTHX_ int full)
     SAVEHINTS();
     PL_hints &= ~HINT_BLOCK_SCOPE;
     SAVEPPTR(PL_compiling.cop_warnings); 
-    if (PL_compiling.cop_warnings != WARN_ALL && 
-       PL_compiling.cop_warnings != WARN_NONE) {
+    if (! specialWARN(PL_compiling.cop_warnings)) {
         PL_compiling.cop_warnings = newSVsv(PL_compiling.cop_warnings) ;
         SAVEFREESV(PL_compiling.cop_warnings) ;
     }
@@ -3062,8 +3062,7 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
     }
     cop->cop_seq = seq;
     cop->cop_arybase = PL_curcop->cop_arybase;
-    if (PL_curcop->cop_warnings == WARN_NONE 
-       || PL_curcop->cop_warnings == WARN_ALL)
+    if (specialWARN(PL_curcop->cop_warnings))
         cop->cop_warnings = PL_curcop->cop_warnings ;
     else 
         cop->cop_warnings = newSVsv(PL_curcop->cop_warnings) ;
@@ -3839,7 +3838,9 @@ Perl_cv_clone(pTHX_ CV *proto)
 void
 Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p)
 {
-    if ((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) {
+    dTHR;
+
+    if (((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) && ckWARN_d(WARN_UNSAFE)) {
        SV* msg = sv_newmortal();
        SV* name = Nullsv;
 
@@ -3855,7 +3856,7 @@ Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p)
            Perl_sv_catpvf(aTHX_ msg, "(%s)", p);
        else
            sv_catpv(msg, "none");
-       Perl_warn(aTHX_ "%_", msg);
+       Perl_warner(aTHX_ WARN_UNSAFE, "%_", msg);
     }
 }
 
@@ -3925,8 +3926,11 @@ Perl_newSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *block)
     if (SvTYPE(gv) != SVt_PVGV) {      /* Prototype now, and had
                                           maximum a prototype before. */
        if (SvTYPE(gv) > SVt_NULL) {
-           if (!SvPOK((SV*)gv) && !(SvIOK((SV*)gv) && SvIVX((SV*)gv) == -1))
-               Perl_warn(aTHX_ "Runaway prototype");
+           if (!SvPOK((SV*)gv) && !(SvIOK((SV*)gv) && SvIVX((SV*)gv) == -1)
+               && ckWARN_d(WARN_UNSAFE))
+           {
+               Perl_warner(aTHX_ WARN_UNSAFE, "Runaway prototype");
+           }
            cv_ckproto((CV*)gv, NULL, ps);
        }
        if (ps)
@@ -4337,7 +4341,8 @@ Perl_oopsAV(pTHX_ OP *o)
        break;
 
     default:
-       Perl_warn(aTHX_ "oops: oopsAV");
+       if (ckWARN_d(WARN_INTERNAL))
+           Perl_warner(aTHX_ WARN_INTERNAL, "oops: oopsAV");
        break;
     }
     return o;
@@ -4346,6 +4351,8 @@ Perl_oopsAV(pTHX_ OP *o)
 OP *
 Perl_oopsHV(pTHX_ OP *o)
 {
+    dTHR;
+    
     switch (o->op_type) {
     case OP_PADSV:
     case OP_PADAV:
@@ -4361,7 +4368,8 @@ Perl_oopsHV(pTHX_ OP *o)
        break;
 
     default:
-       Perl_warn(aTHX_ "oops: oopsHV");
+       if (ckWARN_d(WARN_INTERNAL))
+           Perl_warner(aTHX_ WARN_INTERNAL, "oops: oopsHV");
        break;
     }
     return o;