add deprecation warning for C<my $x if foo> and C<foo && (my $x)>

p4raw-id: //depot/perl@22328

6 files changed, 63 insertions, 5 deletions

diff --git a/op.c b/op.c
index 871a0f62cf..d6d9aee6ff 100644
--- a/op.c
+++ b/op.c
@@ -3313,7 +3313,9 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
 	}
     }
 
-    return prepend_elem(OP_LINESEQ, (OP*)cop, o);
+    o = prepend_elem(OP_LINESEQ, (OP*)cop, o);
+    CHECKOP(cop->op_type, cop);
+    return o;
 }
 
 
@@ -5972,6 +5974,42 @@ Perl_ck_join(pTHX_ OP *o)
 }
 
 OP *
+Perl_ck_state(pTHX_ OP *o)
+{
+    /* warn on C<my $x=1 if foo;> , C<$a && my $x=1;> style statements */
+    OP *kid;
+    o = o->op_sibling;
+    if (!o || o->op_type != OP_NULL || !(o->op_flags & OPf_KIDS))
+	return o;
+    kid = cUNOPo->op_first;
+    if (!(kid->op_type == OP_AND || kid->op_type == OP_OR))
+	return o;
+    kid = kUNOP->op_first->op_sibling;
+    if (kid->op_type == OP_SASSIGN)
+	kid = kBINOP->op_first->op_sibling;
+    else if (kid->op_type == OP_AASSIGN)
+	kid = kBINOP->op_first->op_sibling;
+
+    if (kid->op_type == OP_LIST
+	    || (kid->op_type == OP_NULL && kid->op_targ == OP_LIST))
+    {
+	kid = kUNOP->op_first;
+	if (kid->op_type == OP_PUSHMARK)
+	    kid = kid->op_sibling;
+    }
+    if ((kid->op_type == OP_PADSV || kid->op_type == OP_PADAV
+	    || kid->op_type == OP_PADHV)
+	&& (kid->op_private & OPpLVAL_INTRO)
+	&& (ckWARN(WARN_DEPRECATED)))
+    {
+	Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
+			    "Use of my in conditional deprecated");
+    }
+    return o;
+}
+
+
+OP *
 Perl_ck_subr(pTHX_ OP *o)
 {
     OP *prev = ((cUNOPo->op_first->op_sibling)
diff --git a/opcode.h b/opcode.h
index 81ab818f98..7d0e111d6f 100644
--- a/opcode.h
+++ b/opcode.h
@@ -1291,8 +1291,8 @@ EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op) = {
 	MEMBER_TO_FPTR(Perl_ck_die),	/* die */
 	MEMBER_TO_FPTR(Perl_ck_fun),	/* reset */
 	MEMBER_TO_FPTR(Perl_ck_null),	/* lineseq */
-	MEMBER_TO_FPTR(Perl_ck_null),	/* nextstate */
-	MEMBER_TO_FPTR(Perl_ck_null),	/* dbstate */
+	MEMBER_TO_FPTR(Perl_ck_state),	/* nextstate */
+	MEMBER_TO_FPTR(Perl_ck_state),	/* dbstate */
 	MEMBER_TO_FPTR(Perl_ck_null),	/* unstack */
 	MEMBER_TO_FPTR(Perl_ck_null),	/* enter */
 	MEMBER_TO_FPTR(Perl_ck_null),	/* leave */
diff --git a/opcode.pl b/opcode.pl
index 1fe1f3ca89..10e252c246 100755
--- a/opcode.pl
+++ b/opcode.pl
@@ -684,8 +684,8 @@ die		die			ck_die		dimst@	L
 reset		symbol reset		ck_fun		is%	S?
 
 lineseq		line sequence		ck_null		@	
-nextstate	next statement		ck_null		s;	
-dbstate		debug next statement	ck_null		s;	
+nextstate	next statement		ck_state	s;	
+dbstate		debug next statement	ck_state	s;	
 unstack		iteration finalizer	ck_null		s0
 enter		block entry		ck_null		0	
 leave		block exit		ck_null		@	
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 38be87a625..19bfa5efa4 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -4282,6 +4282,24 @@ old way has bad side effects.
 it already went past any symlink you are presumably trying to look for.
 The operation returned C<undef>.  Use a filename instead.
 
+=item Use of my in conditional deprecated
+
+(D deprecated) You used a C<my> declaration within a conditional
+expression of some sort, such as C<my $x=1 if foo> or C<foo && (my $x = 1)>.
+Perl's run-time behaviour in such constructs is currently undefined, but
+typically causes the variable not be be cleared at the end of scope and
+to retain its old value the next time the scope is entered. Some people
+have been making use of this "feature" to implement a type of static
+variable. We intend to change this behaviour in a future release, so
+don't rely on it.
+
+To work around this warning, move the declaration outside the expression,
+eg
+
+    my $x;
+    $x = 1 if foo;
+
+
 =item Use of "package" with no arguments is deprecated
 
 (D deprecated) You used the C<package> keyword without specifying a package
diff --git a/pp.sym b/pp.sym
index 00d4e7eef3..a30f2f4133 100644
--- a/pp.sym
+++ b/pp.sym
@@ -39,6 +39,7 @@ Perl_ck_shift
 Perl_ck_sort
 Perl_ck_spair
 Perl_ck_split
+Perl_ck_state
 Perl_ck_subr
 Perl_ck_substr
 Perl_ck_svconst
diff --git a/pp_proto.h b/pp_proto.h
index 2f457c37fd..9b9b7c16bf 100644
--- a/pp_proto.h
+++ b/pp_proto.h
@@ -38,6 +38,7 @@ PERL_CKDEF(Perl_ck_shift)
 PERL_CKDEF(Perl_ck_sort)
 PERL_CKDEF(Perl_ck_spair)
 PERL_CKDEF(Perl_ck_split)
+PERL_CKDEF(Perl_ck_state)
 PERL_CKDEF(Perl_ck_subr)
 PERL_CKDEF(Perl_ck_substr)
 PERL_CKDEF(Perl_ck_svconst)