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

p4raw-id: //depot/perl@22328

diff --git a/op.c b/op.c
index 871a0f6..d6d9aee 100644 (file)
--- 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 81ab818..7d0e111 100644 (file)
--- 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 1fe1f3c..10e252c 100755 (executable)
--- 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 38be87a..19bfa5e 100644 (file)
--- 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 00d4e7e..a30f2f4 100644 (file)
--- 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 2f457c3..9b9b7c1 100644 (file)
--- 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)