X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=d7a523473bda11af5696fda9a30d7a8e1f496e84;hb=d2d1d4de13bedc11af82b2ca4fd580671530195c;hp=796bec3784b9672b66c40a74eed2fae31bb7c8a3;hpb=867fa1e2da145229b4db2c6e8d5b51700c15f114;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/op.c b/op.c
index 796bec3..d7a5234 100644
--- a/op.c
+++ b/op.c
@@ -1540,12 +1540,17 @@ Perl_mod(pTHX_ OP *o, I32 type)
     case OP_DBSTATE:
        PL_modcount = RETURN_UNLIMITED_NUMBER;
 	break;
+    case OP_AV2ARYLEN:
+	PL_hints |= HINT_BLOCK_SCOPE;
+	if (type == OP_LEAVESUBLV)
+	    o->op_private |= OPpMAYBE_LVSUB;
+	PL_modcount++;
+	break;
     case OP_RV2SV:
 	ref(cUNOPo->op_first, o->op_type);
 	localize = 1;
 	/* FALL THROUGH */
     case OP_GV:
-    case OP_AV2ARYLEN:
 	PL_hints |= HINT_BLOCK_SCOPE;
     case OP_SASSIGN:
     case OP_ANDASSIGN:
@@ -4571,8 +4576,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 		&& o2->op_private & OPpLVAL_INTRO
 		&& !(o2->op_private & OPpPAD_STATE))
 	    {
-		Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
-			       "Deprecated use of my() in false conditional");
+		Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
+				 "Deprecated use of my() in false conditional");
 	    }
 
 	    *otherp = NULL;
@@ -4784,7 +4789,9 @@ Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block)
     if (expr) {
 	if (once && expr->op_type == OP_CONST && !SvTRUE(((SVOP*)expr)->op_sv))
 	    return block;	/* do {} while 0 does once */
-	if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
+	if (expr->op_type == OP_READLINE
+	    || expr->op_type == OP_READDIR
+	    || expr->op_type == OP_GLOB
 	    || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB)) {
 	    expr = newUNOP(OP_DEFINED, 0,
 		newASSIGNOP(0, newDEFSVOP(), 0, expr) );
@@ -4793,7 +4800,7 @@ Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block)
 	    const OP * const k2 = k1 ? k1->op_sibling : NULL;
 	    switch (expr->op_type) {
 	      case OP_NULL:
-		if (k2 && k2->op_type == OP_READLINE
+		if (k2 && (k2->op_type == OP_READLINE || k2->op_type == OP_READDIR)
 		      && (k2->op_flags & OPf_STACKED)
 		      && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR))
 		    expr = newUNOP(OP_DEFINED, 0, expr);
@@ -4846,7 +4853,9 @@ whileline, OP *expr, OP *block, OP *cont, I32 has_my)
     PERL_UNUSED_ARG(debuggable);
 
     if (expr) {
-	if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
+	if (expr->op_type == OP_READLINE
+         || expr->op_type == OP_READDIR
+         || expr->op_type == OP_GLOB
 		     || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB)) {
 	    expr = newUNOP(OP_DEFINED, 0,
 		newASSIGNOP(0, newDEFSVOP(), 0, expr) );
@@ -4855,7 +4864,7 @@ whileline, OP *expr, OP *block, OP *cont, I32 has_my)
 	    const OP * const k2 = (k1) ? k1->op_sibling : NULL;
 	    switch (expr->op_type) {
 	      case OP_NULL:
-		if (k2 && k2->op_type == OP_READLINE
+		if (k2 && (k2->op_type == OP_READLINE || k2->op_type == OP_READDIR)
 		      && (k2->op_flags & OPf_STACKED)
 		      && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR))
 		    expr = newUNOP(OP_DEFINED, 0, expr);
@@ -6265,7 +6274,7 @@ Perl_newAVREF(pTHX_ OP *o)
 	return o;
     }
     else if ((o->op_type == OP_RV2AV || o->op_type == OP_PADAV)) {
-	Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
+	Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
 		       "Using an array as a reference is deprecated");
     }
     return newUNOP(OP_RV2AV, 0, scalar(o));
@@ -6292,7 +6301,7 @@ Perl_newHVREF(pTHX_ OP *o)
 	return o;
     }
     else if ((o->op_type == OP_RV2HV || o->op_type == OP_PADHV)) {
-	Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
+	Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
 		       "Using a hash as a reference is deprecated");
     }
     return newUNOP(OP_RV2HV, 0, scalar(o));
@@ -6845,7 +6854,7 @@ Perl_ck_fun(pTHX_ OP *o)
 		{
 		    OP * const newop = newAVREF(newGVOP(OP_GV, 0,
 			gv_fetchsv(((SVOP*)kid)->op_sv, GV_ADD, SVt_PVAV) ));
-		    Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
+		    Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
 				   "Array @%"SVf" missing the @ in argument %"IVdf" of %s()",
 				   SVfARG(((SVOP*)kid)->op_sv), (IV)numargs, PL_op_desc[type]);
 #ifdef PERL_MAD
@@ -6867,7 +6876,7 @@ Perl_ck_fun(pTHX_ OP *o)
 		{
 		    OP * const newop = newHVREF(newGVOP(OP_GV, 0,
 			gv_fetchsv(((SVOP*)kid)->op_sv, GV_ADD, SVt_PVHV) ));
-		    Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
+		    Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
 				   "Hash %%%"SVf" missing the %% in argument %"IVdf" of %s()",
 				   SVfARG(((SVOP*)kid)->op_sv), (IV)numargs, PL_op_desc[type]);
 #ifdef PERL_MAD
@@ -7215,21 +7224,16 @@ Perl_ck_defined(pTHX_ OP *o)		/* 19990527 MJD */
 	    break;                      /* Globals via GV can be undef */
 	case OP_PADAV:
 	case OP_AASSIGN:		/* Is this a good idea? */
-	    Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
+	    Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
 			   "defined(@array) is deprecated");
-	    Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
+	    Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
 			   "\t(Maybe you should just omit the defined()?)\n");
 	break;
 	case OP_RV2HV:
-	    /* This is needed for
-	       if (defined %stash::)
-	       to work.   Do not break Tk.
-	       */
-	    break;                      /* Globals via GV can be undef */
 	case OP_PADHV:
-	    Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
+	    Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
 			   "defined(%%hash) is deprecated");
-	    Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
+	    Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
 			   "\t(Maybe you should just omit the defined()?)\n");
 	    break;
 	default: