From: Dave Mitchell <davem@fdisolutions.com>
Date: Wed, 30 Apr 2003 21:17:38 +0000 (+0100)
Subject: New warning "Useless localization of %s", based on
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ddeae0f14c58a5f1101e1a8c75be3b67f60cf6fd;p=p5sagit%2Fp5-mst-13.2.git

New warning "Useless localization of %s", based on
Subject: [PATCH] new warning "Useless localization of %s is deprecated"
Message-ID: <20030430201738.GA22054@fdgroup.com>

The proposed patch added this warning in the 'deprecated' category ;
I think this category is for things that exist and will be removed,
rather than for things that don't exist and that will maybe be added.

p4raw-id: //depot/perl@19588
---

diff --git a/op.c b/op.c
index 97e6e73..f3e616f 100644
--- a/op.c
+++ b/op.c
@@ -888,10 +888,23 @@ S_modkids(pTHX_ OP *o, I32 type)
     return o;
 }
 
+/* Propagate lvalue ("modifiable") context to an op and it's children.
+ * 'type' represents the context type, roughly based on the type of op that
+ * would do the modifying, although local() is represented by OP_NULL.
+ * It's responsible for detecting things that can't be modified,  flag
+ * things that need to behave specially in an lvalue context (e.g., "$$x = 5"
+ * might have to vivify a reference in $x), and so on.
+ *
+ * For example, "$a+1 = 2" would cause mod() to be called with o being
+ * OP_ADD and type being OP_SASSIGN, and would output an error.
+ */
+
 OP *
 Perl_mod(pTHX_ OP *o, I32 type)
 {
     OP *kid;
+    /* -1 = error on localize, 0 = ignore localize, 1 = ok to localize */
+    int localize = -1;
 
     if (!o || PL_error_count)
 	return o;
@@ -904,6 +917,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
 
     switch (o->op_type) {
     case OP_UNDEF:
+	localize = 0;
 	PL_modcount++;
 	return o;
     case OP_CONST:
@@ -1060,6 +1074,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
 	break;
 
     case OP_COND_EXPR:
+	localize = 1;
 	for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
 	    mod(kid, type);
 	break;
@@ -1080,6 +1095,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
     case OP_HSLICE:
 	if (type == OP_LEAVESUBLV)
 	    o->op_private |= OPpMAYBE_LVSUB;
+	localize = 1;
 	/* FALL THROUGH */
     case OP_AASSIGN:
     case OP_NEXTSTATE:
@@ -1088,6 +1104,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
 	break;
     case OP_RV2SV:
 	ref(cUNOPo->op_first, o->op_type);
+	localize = 1;
 	/* FALL THROUGH */
     case OP_GV:
     case OP_AV2ARYLEN:
@@ -1096,7 +1113,11 @@ Perl_mod(pTHX_ OP *o, I32 type)
     case OP_ANDASSIGN:
     case OP_ORASSIGN:
     case OP_DORASSIGN:
+	PL_modcount++;
+	break;
+
     case OP_AELEMFAST:
+	localize = 1;
 	PL_modcount++;
 	break;
 
@@ -1112,17 +1133,13 @@ Perl_mod(pTHX_ OP *o, I32 type)
 	/* FALL THROUGH */
     case OP_PADSV:
 	PL_modcount++;
-	if (!type)
-	{   /* XXX DAPM 2002.08.25 tmp assert test */
-	    /* XXX */ assert(av_fetch(PL_comppad_name, (o->op_targ), FALSE));
-	    /* XXX */ assert(*av_fetch(PL_comppad_name, (o->op_targ), FALSE));
-
+	if (!type) /* local() */
 	    Perl_croak(aTHX_ "Can't localize lexical variable %s",
 		 PAD_COMPNAME_PV(o->op_targ));
-	}
 	break;
 
     case OP_PUSHMARK:
+	localize = 0;
 	break;
 
     case OP_KEYS:
@@ -1153,6 +1170,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
 	    o->op_private |= OPpLVAL_DEFER;
 	if (type == OP_LEAVESUBLV)
 	    o->op_private |= OPpMAYBE_LVSUB;
+	localize = 1;
 	PL_modcount++;
 	break;
 
@@ -1160,11 +1178,13 @@ Perl_mod(pTHX_ OP *o, I32 type)
     case OP_LEAVE:
     case OP_ENTER:
     case OP_LINESEQ:
+	localize = 0;
 	if (o->op_flags & OPf_KIDS)
 	    mod(cLISTOPo->op_last, type);
 	break;
 
     case OP_NULL:
+	localize = 0;
 	if (o->op_flags & OPf_SPECIAL)		/* do BLOCK */
 	    goto nomod;
 	else if (!(o->op_flags & OPf_KIDS))
@@ -1175,6 +1195,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
 	}
 	/* FALL THROUGH */
     case OP_LIST:
+	localize = 0;
 	for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
 	    mod(kid, type);
 	break;
@@ -1197,10 +1218,21 @@ Perl_mod(pTHX_ OP *o, I32 type)
 
     if (type == OP_AASSIGN || type == OP_SASSIGN)
 	o->op_flags |= OPf_SPECIAL|OPf_REF;
-    else if (!type) {
-	o->op_private |= OPpLVAL_INTRO;
-	o->op_flags &= ~OPf_SPECIAL;
-	PL_hints |= HINT_BLOCK_SCOPE;
+    else if (!type) { /* local() */
+	switch (localize) {
+	case 1:
+	    o->op_private |= OPpLVAL_INTRO;
+	    o->op_flags &= ~OPf_SPECIAL;
+	    PL_hints |= HINT_BLOCK_SCOPE;
+	    break;
+	case 0:
+	    break;
+	case -1:
+	    if (ckWARN(WARN_SYNTAX)) {
+		Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
+		    "Useless localization of %s", OP_DESC(o));
+	    }
+	}
     }
     else if (type != OP_GREPSTART && type != OP_ENTERSUB
              && type != OP_LEAVESUBLV)
@@ -5104,10 +5136,6 @@ Perl_ck_fun(pTHX_ OP *o)
 			     */
 			    priv = OPpDEREF;
 			    if (kid->op_type == OP_PADSV) {
-				/*XXX DAPM 2002.08.25 tmp assert test */
-				/*XXX*/ assert(av_fetch(PL_comppad_name, (kid->op_targ), FALSE));
-				/*XXX*/ assert(*av_fetch(PL_comppad_name, (kid->op_targ), FALSE));
-
 				name = PAD_COMPNAME_PV(kid->op_targ);
 				/* SvCUR of a pad namesv can't be trusted
 				 * (see PL_generation), so calc its length
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 3cd763b..6e7543d 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -4050,6 +4050,12 @@ must be written as
 The <-- HERE shows in the regular expression about
 where the problem was discovered. See L<perlre>.
 
+=item Useless localization of %s
+
+(W syntax) The localization of lvalues such as C<local($x=10)> is
+legal, but in fact the local() currently has no effect. This may change at
+some point in the future, but in the meantime such code is discouraged.
+
 =item Useless use of %s in void context
 
 (W void) You did something without a side effect in a context that does
diff --git a/t/lib/warnings/op b/t/lib/warnings/op
index dff697d..58056a6 100644
--- a/t/lib/warnings/op
+++ b/t/lib/warnings/op
@@ -952,3 +952,87 @@ Possible precedence problem on bitwise & operator at - line 7.
 Possible precedence problem on bitwise ^ operator at - line 8.
 Possible precedence problem on bitwise | operator at - line 9.
 Possible precedence problem on bitwise & operator at - line 10.
+########
+# op.c
+
+# ok	=> local() has desired effect;
+# ignore=> local() silently ignored
+
+use warnings 'syntax';
+
+local(undef);		# OP_UNDEF		ignore
+sub lval : lvalue {};
+local(lval());		# OP_ENTERSUB
+local($x **= 1);	# OP_POW
+local($x *=  1);	# OP_MULTIPLY
+local($x /=  1);	# OP_DIVIDE
+local($x %=  1);	# OP_MODULO
+local($x x=  1);	# OP_REPEAT
+local($x +=  1);	# OP_ADD
+local($x -=  1);	# OP_SUBTRACT
+local($x .=  1);	# OP_CONCAT
+local($x <<= 1);	# OP_LEFT_SHIFT
+local($x >>= 1);	# OP_RIGHT_SHIFT
+local($x &=  1);	# OP_BIT_AND
+local($x ^=  1);	# OP_BIT_XOR
+local($x |=  1);	# OP_BIT_OR
+{
+    use integer;
+    local($x *= 1);	# OP_I_MULTIPLY
+    local($x /= 1);	# OP_I_DIVIDE
+    local($x %= 1);	# OP_I_MODULO
+    local($x += 1);	# OP_I_ADD
+    local($x -= 1);	# OP_I_SUBTRACT
+}
+local($x?$y:$z) = 1;	# OP_COND_EXPR		ok
+# these two are fatal run-time errors instead
+#local(@$a);		# OP_RV2AV		ok
+#local(%$a);		# OP_RV2HV		ok
+local(*a);		# OP_RV2GV		ok
+local(@a[1,2]);		# OP_ASLICE		ok
+local(@a{1,2});		# OP_HSLICE		ok
+local(@a = (1,2));	# OP_AASSIGN
+local($$x);		# OP_RV2SV		ok
+local($#a);		# OP_AV2ARYLEN
+local($x =   1);	# OP_SASSIGN
+local($x &&= 1);	# OP_ANDASSIGN
+local($x ||= 1);	# OP_ORASSIGN
+local($x //= 1);	# OP_DORASSIGN
+local($a[0]);		# OP_AELEMFAST		ok
+
+local(substr($x,0,1));	# OP_SUBSTR
+local(pos($x));		# OP_POS
+local(vec($x,0,1));	# OP_VEC
+local($a[$b]);		# OP_AELEM		ok
+local($a{$b});		# OP_HELEM		ok
+
+no warnings 'syntax';
+EXPECT
+Useless localization of subroutine entry at - line 10.
+Useless localization of exponentiation (**) at - line 11.
+Useless localization of multiplication (*) at - line 12.
+Useless localization of division (/) at - line 13.
+Useless localization of modulus (%) at - line 14.
+Useless localization of repeat (x) at - line 15.
+Useless localization of addition (+) at - line 16.
+Useless localization of subtraction (-) at - line 17.
+Useless localization of concatenation (.) or string at - line 18.
+Useless localization of left bitshift (<<) at - line 19.
+Useless localization of right bitshift (>>) at - line 20.
+Useless localization of bitwise and (&) at - line 21.
+Useless localization of bitwise xor (^) at - line 22.
+Useless localization of bitwise or (|) at - line 23.
+Useless localization of integer multiplication (*) at - line 26.
+Useless localization of integer division (/) at - line 27.
+Useless localization of integer modulus (%) at - line 28.
+Useless localization of integer addition (+) at - line 29.
+Useless localization of integer subtraction (-) at - line 30.
+Useless localization of list assignment at - line 39.
+Useless localization of array length at - line 41.
+Useless localization of scalar assignment at - line 42.
+Useless localization of logical and assignment (&&=) at - line 43.
+Useless localization of logical or assignment (||=) at - line 44.
+Useless localization of defined or assignment (//=) at - line 45.
+Useless localization of substr at - line 48.
+Useless localization of match position at - line 49.
+Useless localization of vec at - line 50.