lexical warnings update (warning.t fails one test

due to leaked scalar, investigation pending)
	Message-ID: <5104D4DBC598D211B5FE0000F8FE7EB29C6C8E@mbtlipnt02.btlabs.bt.co.uk>
	Subject: [PATCH 5.005_57] Lexical Warnings - mandatory warning are now default warnings

p4raw-id: //depot/perl@3640

1 files changed, 22 insertions, 13 deletions

diff --git a/op.c b/op.c
index 81df30e207..f4dc624fce 100644
--- 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,10 @@ 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 +3857,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 +3927,9 @@ 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 +4340,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 +4350,10 @@ Perl_oopsAV(pTHX_ OP *o)
 OP *
 Perl_oopsHV(pTHX_ OP *o)
 {
+    dTHR;
+
+    dTHR;
+    
     switch (o->op_type) {
     case OP_PADSV:
     case OP_PADAV:
@@ -4361,7 +4369,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;