summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2013-09-14 17:23:11 -0700
committerFather Chrysostomos <sprout@cpan.org>2013-09-14 18:24:21 -0700
commit429a25554a608b64c0ee46c1ffe19bab3718a3c8 (patch)
tree14715e2179b09d1708fb9b6bf4516187b225cbe5
parent61c85d894087ca7f0282600eb64d5af1e7b8e5d4 (diff)
downloadperl-429a25554a608b64c0ee46c1ffe19bab3718a3c8.tar.gz
Reduce false positives for @hsh{$s} and @ary[$s] warnings
This resolves tickets #28380 and #114024. Commit 95a31aad5 did something similar to this for the new %hash{...} syntax. This commit extends it to @ slices and combines the two code paths. The heuristics in toke.c can easily produce false positives. So the op is flagged as being a candidate for the warning. Then when op.c has the op tree available, it examines it to see whether the heuristic may have been a false positive. This avoids bugs with qw "foo bar baz" and sub calls triggering the warning. The source code is no longer available for the warning, so we recon- struct it from the op tree, skipping the subscript if it is anything other than a const op. This means that @hash{$foo} comes out as @hash{...} and @hash{foo} as @hash{"foo"}. It also meeans that @hash{"]"} is displayed correctly instead of as @hash{"]. Commit 95a31aad5 also modified the heuristic for %hash{...} to exempt qw altogether. But it did not exempt it if it was preceded by a tab. So this commit rectifies that. This commit also improves the false positive detection by exempting any ops returning lists that can get past toke.c’s heuristic. I went through the entire list of ops, but I may have missed some. Also, @ slices on the lhs of = are exempt, as they change the context and are hence actually useful.
-rw-r--r--dump.c1
-rw-r--r--ext/B/B/Concise.pm2
-rw-r--r--op.c146
-rw-r--r--op.h2
-rw-r--r--perly.act109
-rw-r--r--perly.h2
-rw-r--r--perly.tab14
-rw-r--r--perly.y7
-rw-r--r--t/lib/warnings/op146
-rw-r--r--toke.c40
10 files changed, 321 insertions, 148 deletions
diff --git a/dump.c b/dump.c
index 881759ff5a..1aa96ced7c 100644
--- a/dump.c
+++ b/dump.c
@@ -956,6 +956,7 @@ S_op_private_to_names(pTHX_ SV *tmpsv, U32 optype, U32 op_private) {
(UV)(oppriv & OPpPADRANGE_COUNTMASK)); \
if ( (o->op_type == OP_RV2HV || o->op_type == OP_RV2AV || \
o->op_type == OP_PADAV || o->op_type == OP_PADHV || \
+ o->op_type == OP_ASLICE || o->op_type == OP_HSLICE || \
o->op_type == OP_KVHSLICE || o->op_type == OP_KVASLICE) \
&& oppriv & OPpSLICEWARNING ) \
sv_catpvs(tmpsv, ",SLICEWARNING"); \
diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index 40399543ff..c644d30245 100644
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -619,7 +619,7 @@ $priv{$_}{8} = "LVSUB"
for qw(rv2av rv2gv rv2hv padav padhv aelem helem aslice hslice
av2arylen keys rkeys substr pos vec);
$priv{$_}{4} = "SLICEWARN"
- for qw(rv2hv rv2av kvhslice kvaslice padav padhv);
+ for qw(rv2hv rv2av kvhslice kvaslice padav padhv hslice aslice);
@{$priv{$_}}{32,64} = qw(BOOL BOOL?) for qw(rv2hv padhv);
$priv{substr}{16} = "REPL1ST";
$priv{$_}{16} = "TARGMY"
diff --git a/op.c b/op.c
index a70deb7bd5..c7626e3ea3 100644
--- a/op.c
+++ b/op.c
@@ -1144,6 +1144,91 @@ S_op_varname(pTHX_ const OP *o)
}
}
+static void
+S_scalar_slice_warning(pTHX_ const OP *o)
+{
+ OP *kid;
+ const char lbrack =
+ o->op_type == OP_KVHSLICE || o->op_type == OP_HSLICE ? '{' : '[';
+ const char rbrack =
+ o->op_type == OP_KVHSLICE || o->op_type == OP_HSLICE ? '}' : ']';
+ const char funny =
+ o->op_type == OP_ASLICE || o->op_type == OP_HSLICE ? '@' : '%';
+ SV *name;
+ SV *keysv;
+ const char *key = NULL;
+
+ if (!(o->op_private & OPpSLICEWARNING))
+ return;
+ if (PL_parser && PL_parser->error_count)
+ /* This warning can be nonsensical when there is a syntax error. */
+ return;
+
+ kid = cLISTOPo->op_first;
+ kid = kid->op_sibling; /* get past pushmark */
+ /* weed out false positives: any ops that can return lists */
+ switch (kid->op_type) {
+ case OP_BACKTICK:
+ case OP_GLOB:
+ case OP_READLINE:
+ case OP_MATCH:
+ case OP_RV2AV:
+ case OP_EACH:
+ case OP_VALUES:
+ case OP_KEYS:
+ case OP_SPLIT:
+ case OP_LIST:
+ case OP_SORT:
+ case OP_REVERSE:
+ case OP_ENTERSUB:
+ case OP_CALLER:
+ case OP_LSTAT:
+ case OP_STAT:
+ case OP_READDIR:
+ case OP_SYSTEM:
+ case OP_TMS:
+ case OP_LOCALTIME:
+ case OP_GMTIME:
+ case OP_ENTEREVAL:
+ case OP_REACH:
+ case OP_RKEYS:
+ case OP_RVALUES:
+ return;
+ }
+ assert(kid->op_sibling);
+ name = S_op_varname(aTHX_ kid->op_sibling);
+ if (!name) /* XS module fiddling with the op tree */
+ return;
+ if (kid->op_type == OP_CONST) {
+ keysv = kSVOP_sv;
+ if (SvPOK(kSVOP_sv)) {
+ SV *sv = keysv;
+ keysv = sv_newmortal();
+ pv_pretty(keysv, SvPVX_const(sv), SvCUR(sv), 32, NULL, NULL,
+ PERL_PV_PRETTY_DUMP |PERL_PV_ESCAPE_UNI_DETECT);
+ }
+ else if (!SvOK(keysv))
+ key = "undef";
+ }
+ else key = "...";
+ assert(SvPOK(name));
+ sv_chop(name,SvPVX(name)+1);
+ if (key)
+ /* diag_listed_as: Scalar value %%s[%s] better written as $%s[%s] */
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
+ "Scalar value %c%"SVf"%c%s%c better written as $%"SVf
+ "%c%s%c",
+ funny, SVfARG(name), lbrack, key, rbrack, SVfARG(name),
+ lbrack, key, rbrack);
+ else
+ /* diag_listed_as: Scalar value %%s[%s] better written as $%s[%s] */
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
+ "Scalar value %c%"SVf"%c%"SVf"%c better written as $%"
+ SVf"%c%"SVf"%c",
+ funny, SVfARG(name), lbrack, keysv, rbrack,
+ SVfARG(name), lbrack, keysv, rbrack);
+}
+
OP *
Perl_scalar(pTHX_ OP *o)
{
@@ -1208,58 +1293,7 @@ Perl_scalar(pTHX_ OP *o)
break;
case OP_KVHSLICE:
case OP_KVASLICE:
- if (o->op_private & OPpSLICEWARNING) {
- OP *kid = cLISTOPo->op_first;
- if (kid) {
- kid = kid->op_sibling; /* get past pushmark */
- /* weed out false positives: op_list and op_entersub */
- if (kid->op_type != OP_LIST && kid->op_type != OP_ENTERSUB
- && kid->op_sibling) {
- const char lbrack =
- o->op_type == OP_KVHSLICE ? '{' : '[';
- const char rbrack =
- o->op_type == OP_KVHSLICE ? '}' : ']';
- SV * const name = S_op_varname(aTHX_ kid->op_sibling);
- SV *keysv;
- const char *key = NULL;
- if (!name) /* XS module fiddling with the op tree */
- break;
- if (kid->op_type == OP_CONST) {
- keysv = kSVOP_sv;
- if (SvPOK(kSVOP_sv)) {
- SV *sv = keysv;
- keysv = sv_newmortal();
- pv_pretty(keysv, SvPVX_const(sv), SvCUR(sv),
- 32, NULL, NULL,
- PERL_PV_PRETTY_DUMP
- |PERL_PV_ESCAPE_UNI_DETECT);
- }
- else if (!SvOK(keysv))
- key = "undef";
- }
- else key = "...";
- assert(name);
- assert(SvPOK(name));
- sv_chop(name,SvPVX(name)+1);
- if (key)
- /* diag_listed_as: Scalar value %%s[%s] better written as $%s[%s] */
- Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
- "Scalar value %%%"SVf
- "%c%s%c better written as $%"SVf
- "%c%s%c",
- SVfARG(name), lbrack, key, rbrack,
- SVfARG(name), lbrack, key, rbrack);
- else
- /* diag_listed_as: Scalar value %%s[%s] better written as $%s[%s] */
- Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
- "Scalar value %%%"SVf"%c%"SVf
- "%c better written as $%"SVf
- "%c%"SVf"%c",
- SVfARG(name), lbrack, keysv, rbrack,
- SVfARG(name), lbrack, keysv, rbrack);
- }
- }
- }
+ S_scalar_slice_warning(aTHX_ o);
}
return o;
}
@@ -1896,6 +1930,8 @@ S_finalize_op(pTHX_ OP* o)
STRLEN keylen;
SVOP *first_key_op, *key_op;
+ S_scalar_slice_warning(aTHX_ o);
+
if ((o->op_private & (OPpLVAL_INTRO))
/* I bet there's always a pushmark... */
|| ((LISTOP*)o)->op_first->op_sibling->op_type != OP_LIST)
@@ -1943,6 +1979,9 @@ S_finalize_op(pTHX_ OP* o)
}
break;
}
+ case OP_ASLICE:
+ S_scalar_slice_warning(aTHX_ o);
+ break;
case OP_SUBST: {
if (cPMOPo->op_pmreplrootu.op_pmreplroot)
@@ -5549,6 +5588,9 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
OP *curop;
bool maybe_common_vars = TRUE;
+ if (left->op_type == OP_ASLICE || left->op_type == OP_HSLICE)
+ left->op_private &= ~ OPpSLICEWARNING;
+
PL_modcount = 0;
left = op_lvalue(left, OP_AASSIGN);
curop = list(force_list(left));
diff --git a/op.h b/op.h
index f491e2e275..3978acdfa4 100644
--- a/op.h
+++ b/op.h
@@ -221,7 +221,7 @@ Deprecated. Use C<GIMME_V> instead.
#define OPpEARLY_CV 32 /* foo() called before sub foo was parsed */
/* OP_?ELEM only */
#define OPpLVAL_DEFER 16 /* Defer creation of array/hash elem */
- /* OP_RV2[AH]V OP_KV[AH]SLICE */
+ /* OP_RV2[AH]V OP_KV[AH]SLICE OP_[AH]SLICE */
#define OPpSLICEWARNING 4 /* warn about %hash{$scalar} */
/* OP_RV2[SAH]V, OP_GVSV, OP_ENTERITER only */
#define OPpOUR_INTRO 16 /* Variable was in an our() */
diff --git a/perly.act b/perly.act
index 67596ca2a9..f6e1365c64 100644
--- a/perly.act
+++ b/perly.act
@@ -1422,13 +1422,16 @@ case 2:
newLISTOP(OP_ASLICE, 0,
list((ps[(3) - (4)].val.opval)),
ref((ps[(1) - (4)].val.opval), OP_ASLICE)));
+ if ((yyval.opval) && (ps[(1) - (4)].val.opval))
+ (yyval.opval)->op_private |=
+ (ps[(1) - (4)].val.opval)->op_private & OPpSLICEWARNING;
TOKEN_GETMAD((ps[(2) - (4)].val.i_tkval),(yyval.opval),'[');
TOKEN_GETMAD((ps[(4) - (4)].val.i_tkval),(yyval.opval),']');
;}
break;
case 176:
-#line 1208 "perly.y"
+#line 1211 "perly.y"
{ (yyval.opval) = op_prepend_elem(OP_KVASLICE,
newOP(OP_PUSHMARK, 0),
newLISTOP(OP_KVASLICE, 0,
@@ -1443,12 +1446,15 @@ case 2:
break;
case 177:
-#line 1220 "perly.y"
+#line 1223 "perly.y"
{ (yyval.opval) = op_prepend_elem(OP_HSLICE,
newOP(OP_PUSHMARK, 0),
newLISTOP(OP_HSLICE, 0,
list((ps[(3) - (5)].val.opval)),
ref(oopsHV((ps[(1) - (5)].val.opval)), OP_HSLICE)));
+ if ((yyval.opval) && (ps[(1) - (5)].val.opval))
+ (yyval.opval)->op_private |=
+ (ps[(1) - (5)].val.opval)->op_private & OPpSLICEWARNING;
PL_parser->expect = XOPERATOR;
TOKEN_GETMAD((ps[(2) - (5)].val.i_tkval),(yyval.opval),'{');
TOKEN_GETMAD((ps[(4) - (5)].val.i_tkval),(yyval.opval),';');
@@ -1457,7 +1463,7 @@ case 2:
break;
case 178:
-#line 1231 "perly.y"
+#line 1237 "perly.y"
{ (yyval.opval) = op_prepend_elem(OP_KVHSLICE,
newOP(OP_PUSHMARK, 0),
newLISTOP(OP_KVHSLICE, 0,
@@ -1474,17 +1480,17 @@ case 2:
break;
case 179:
-#line 1245 "perly.y"
+#line 1251 "perly.y"
{ (yyval.opval) = (ps[(1) - (1)].val.opval); ;}
break;
case 180:
-#line 1247 "perly.y"
+#line 1253 "perly.y"
{ (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar((ps[(1) - (1)].val.opval))); ;}
break;
case 181:
-#line 1249 "perly.y"
+#line 1255 "perly.y"
{ (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[(1) - (3)].val.opval)));
TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval),(yyval.opval),'(');
TOKEN_GETMAD((ps[(3) - (3)].val.i_tkval),(yyval.opval),')');
@@ -1492,7 +1498,7 @@ case 2:
break;
case 182:
-#line 1254 "perly.y"
+#line 1260 "perly.y"
{
(yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST, (ps[(3) - (4)].val.opval), scalar((ps[(1) - (4)].val.opval))));
@@ -1508,7 +1514,7 @@ case 2:
break;
case 183:
-#line 1267 "perly.y"
+#line 1273 "perly.y"
{ (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST, (ps[(3) - (3)].val.opval), scalar((ps[(2) - (3)].val.opval))));
TOKEN_GETMAD((ps[(1) - (3)].val.i_tkval),(yyval.opval),'o');
@@ -1516,7 +1522,7 @@ case 2:
break;
case 184:
-#line 1272 "perly.y"
+#line 1278 "perly.y"
{ (yyval.opval) = newOP(IVAL((ps[(1) - (1)].val.i_tkval)), OPf_SPECIAL);
PL_hints |= HINT_BLOCK_SCOPE;
TOKEN_GETMAD((ps[(1) - (1)].val.i_tkval),(yyval.opval),'o');
@@ -1524,74 +1530,74 @@ case 2:
break;
case 185:
-#line 1277 "perly.y"
+#line 1283 "perly.y"
{ (yyval.opval) = newLOOPEX(IVAL((ps[(1) - (2)].val.i_tkval)),(ps[(2) - (2)].val.opval));
TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'o');
;}
break;
case 186:
-#line 1281 "perly.y"
+#line 1287 "perly.y"
{ (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[(2) - (2)].val.opval)));
TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'o');
;}
break;
case 187:
-#line 1285 "perly.y"
+#line 1291 "perly.y"
{ (yyval.opval) = newOP(IVAL((ps[(1) - (1)].val.i_tkval)), 0);
TOKEN_GETMAD((ps[(1) - (1)].val.i_tkval),(yyval.opval),'o');
;}
break;
case 188:
-#line 1289 "perly.y"
+#line 1295 "perly.y"
{ (yyval.opval) = newUNOP(IVAL((ps[(1) - (2)].val.i_tkval)), 0, (ps[(2) - (2)].val.opval));
TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'o');
;}
break;
case 189:
-#line 1293 "perly.y"
+#line 1299 "perly.y"
{ (yyval.opval) = newUNOP(IVAL((ps[(1) - (2)].val.i_tkval)), 0, (ps[(2) - (2)].val.opval));
TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'o');
;}
break;
case 190:
-#line 1297 "perly.y"
+#line 1303 "perly.y"
{ (yyval.opval) = newOP(OP_REQUIRE, (ps[(1) - (1)].val.i_tkval) ? OPf_SPECIAL : 0);
TOKEN_GETMAD((ps[(1) - (1)].val.i_tkval),(yyval.opval),'o');
;}
break;
case 191:
-#line 1301 "perly.y"
+#line 1307 "perly.y"
{ (yyval.opval) = newUNOP(OP_REQUIRE, (ps[(1) - (2)].val.i_tkval) ? OPf_SPECIAL : 0, (ps[(2) - (2)].val.opval));
TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'o');
;}
break;
case 192:
-#line 1305 "perly.y"
+#line 1311 "perly.y"
{ (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[(1) - (1)].val.opval))); ;}
break;
case 193:
-#line 1307 "perly.y"
+#line 1313 "perly.y"
{ (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST, (ps[(2) - (2)].val.opval), scalar((ps[(1) - (2)].val.opval)))); ;}
break;
case 194:
-#line 1310 "perly.y"
+#line 1316 "perly.y"
{ (yyval.opval) = newOP(IVAL((ps[(1) - (1)].val.i_tkval)), 0);
TOKEN_GETMAD((ps[(1) - (1)].val.i_tkval),(yyval.opval),'o');
;}
break;
case 195:
-#line 1314 "perly.y"
+#line 1320 "perly.y"
{ (yyval.opval) = newOP(IVAL((ps[(1) - (3)].val.i_tkval)), 0);
TOKEN_GETMAD((ps[(1) - (3)].val.i_tkval),(yyval.opval),'o');
TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval),(yyval.opval),'(');
@@ -1600,12 +1606,12 @@ case 2:
break;
case 196:
-#line 1320 "perly.y"
+#line 1326 "perly.y"
{ (yyval.opval) = (ps[(1) - (1)].val.opval); ;}
break;
case 197:
-#line 1322 "perly.y"
+#line 1328 "perly.y"
{ (yyval.opval) = (ps[(1) - (3)].val.opval);
TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval),(yyval.opval),'(');
TOKEN_GETMAD((ps[(3) - (3)].val.i_tkval),(yyval.opval),')');
@@ -1613,13 +1619,13 @@ case 2:
break;
case 198:
-#line 1327 "perly.y"
+#line 1333 "perly.y"
{ (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
scalar((ps[(1) - (1)].val.opval))); ;}
break;
case 199:
-#line 1330 "perly.y"
+#line 1336 "perly.y"
{ (yyval.opval) = (IVAL((ps[(1) - (3)].val.i_tkval)) == OP_NOT)
? newUNOP(IVAL((ps[(1) - (3)].val.i_tkval)), 0, newSVOP(OP_CONST, 0, newSViv(0)))
: newOP(IVAL((ps[(1) - (3)].val.i_tkval)), OPf_SPECIAL);
@@ -1631,7 +1637,7 @@ case 2:
break;
case 200:
-#line 1339 "perly.y"
+#line 1345 "perly.y"
{ (yyval.opval) = newUNOP(IVAL((ps[(1) - (4)].val.i_tkval)), 0, (ps[(3) - (4)].val.opval));
TOKEN_GETMAD((ps[(1) - (4)].val.i_tkval),(yyval.opval),'o');
TOKEN_GETMAD((ps[(2) - (4)].val.i_tkval),(yyval.opval),'(');
@@ -1640,7 +1646,7 @@ case 2:
break;
case 201:
-#line 1345 "perly.y"
+#line 1351 "perly.y"
{
if ( (ps[(1) - (1)].val.opval)->op_type != OP_TRANS
&& (ps[(1) - (1)].val.opval)->op_type != OP_TRANSR
@@ -1654,7 +1660,7 @@ case 2:
break;
case 202:
-#line 1356 "perly.y"
+#line 1362 "perly.y"
{ (yyval.opval) = pmruntime((ps[(1) - (5)].val.opval), (ps[(4) - (5)].val.opval), 1, (ps[(2) - (5)].val.ival));
TOKEN_GETMAD((ps[(3) - (5)].val.i_tkval),(yyval.opval),'(');
TOKEN_GETMAD((ps[(5) - (5)].val.i_tkval),(yyval.opval),')');
@@ -1662,7 +1668,7 @@ case 2:
break;
case 205:
-#line 1363 "perly.y"
+#line 1369 "perly.y"
{
(yyval.opval) = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0),
newSVOP(OP_CONST, 0, newSVpvs("Unimplemented")));
@@ -1671,7 +1677,7 @@ case 2:
break;
case 207:
-#line 1373 "perly.y"
+#line 1379 "perly.y"
{ (yyval.opval) = my_attrs((ps[(2) - (3)].val.opval),(ps[(3) - (3)].val.opval));
DO_MAD(
token_getmad((ps[(1) - (3)].val.i_tkval),(yyval.opval),'d');
@@ -1682,14 +1688,14 @@ case 2:
break;
case 208:
-#line 1381 "perly.y"
+#line 1387 "perly.y"
{ (yyval.opval) = localize((ps[(2) - (2)].val.opval),IVAL((ps[(1) - (2)].val.i_tkval)));
TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'d');
;}
break;
case 209:
-#line 1388 "perly.y"
+#line 1394 "perly.y"
{ (yyval.opval) = sawparens((ps[(2) - (3)].val.opval));
TOKEN_GETMAD((ps[(1) - (3)].val.i_tkval),(yyval.opval),'(');
TOKEN_GETMAD((ps[(3) - (3)].val.i_tkval),(yyval.opval),')');
@@ -1697,7 +1703,7 @@ case 2:
break;
case 210:
-#line 1393 "perly.y"
+#line 1399 "perly.y"
{ (yyval.opval) = sawparens(newNULLLIST());
TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'(');
TOKEN_GETMAD((ps[(2) - (2)].val.i_tkval),(yyval.opval),')');
@@ -1705,68 +1711,69 @@ case 2:
break;
case 211:
-#line 1398 "perly.y"
+#line 1404 "perly.y"
{ (yyval.opval) = (ps[(1) - (1)].val.opval); ;}
break;
case 212:
-#line 1400 "perly.y"
+#line 1406 "perly.y"
{ (yyval.opval) = (ps[(1) - (1)].val.opval); ;}
break;
case 213:
-#line 1402 "perly.y"
+#line 1408 "perly.y"
{ (yyval.opval) = (ps[(1) - (1)].val.opval); ;}
break;
case 214:
-#line 1407 "perly.y"
+#line 1413 "perly.y"
{ (yyval.opval) = (OP*)NULL; ;}
break;
case 215:
-#line 1409 "perly.y"
+#line 1415 "perly.y"
{ (yyval.opval) = (ps[(1) - (1)].val.opval); ;}
break;
case 216:
-#line 1413 "perly.y"
+#line 1419 "perly.y"
{ (yyval.opval) = (OP*)NULL; ;}
break;
case 217:
-#line 1415 "perly.y"
+#line 1421 "perly.y"
{ (yyval.opval) = (ps[(1) - (1)].val.opval); ;}
break;
case 218:
-#line 1421 "perly.y"
+#line 1427 "perly.y"
{ PL_parser->in_my = 0; (yyval.opval) = my((ps[(1) - (1)].val.opval)); ;}
break;
case 219:
-#line 1425 "perly.y"
+#line 1431 "perly.y"
{ (yyval.opval) = newCVREF(IVAL((ps[(1) - (2)].val.i_tkval)),(ps[(2) - (2)].val.opval));
TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'&');
;}
break;
case 220:
-#line 1431 "perly.y"
+#line 1437 "perly.y"
{ (yyval.opval) = newSVREF((ps[(2) - (2)].val.opval));
TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'$');
;}
break;
case 221:
-#line 1437 "perly.y"
+#line 1443 "perly.y"
{ (yyval.opval) = newAVREF((ps[(2) - (2)].val.opval));
+ if ((yyval.opval)) (yyval.opval)->op_private |= IVAL((ps[(1) - (2)].val.i_tkval));
TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'@');
;}
break;
case 222:
-#line 1443 "perly.y"
+#line 1450 "perly.y"
{ (yyval.opval) = newHVREF((ps[(2) - (2)].val.opval));
if ((yyval.opval)) (yyval.opval)->op_private |= IVAL((ps[(1) - (2)].val.i_tkval));
TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'%');
@@ -1774,36 +1781,36 @@ case 2:
break;
case 223:
-#line 1450 "perly.y"
+#line 1457 "perly.y"
{ (yyval.opval) = newAVREF((ps[(2) - (2)].val.opval));
TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'l');
;}
break;
case 224:
-#line 1456 "perly.y"
+#line 1463 "perly.y"
{ (yyval.opval) = newGVREF(0,(ps[(2) - (2)].val.opval));
TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'*');
;}
break;
case 225:
-#line 1463 "perly.y"
+#line 1470 "perly.y"
{ (yyval.opval) = scalar((ps[(1) - (1)].val.opval)); ;}
break;
case 226:
-#line 1465 "perly.y"
+#line 1472 "perly.y"
{ (yyval.opval) = scalar((ps[(1) - (1)].val.opval)); ;}
break;
case 227:
-#line 1467 "perly.y"
+#line 1474 "perly.y"
{ (yyval.opval) = op_scope((ps[(1) - (1)].val.opval)); ;}
break;
case 228:
-#line 1470 "perly.y"
+#line 1477 "perly.y"
{ (yyval.opval) = (ps[(1) - (1)].val.opval); ;}
break;
@@ -1814,6 +1821,6 @@ case 2:
/* Generated from:
- * 80609b739b642fa427503886445869dfd47021624a1977b902211b38043ed9f1 perly.y
+ * 5b290f371f373fb17e073f602c676e436e9d457a1d4db67d192e3cfa0eeb36d7 perly.y
* 5c9d2a0262457fe9b70073fc8ad6c188f812f38ad57712b7e2f53daa01b297cc regen_perly.pl
* ex: set ro: */
diff --git a/perly.h b/perly.h
index 155dea02d5..3b708a8c1b 100644
--- a/perly.h
+++ b/perly.h
@@ -266,6 +266,6 @@ typedef union YYSTYPE
/* Generated from:
- * 80609b739b642fa427503886445869dfd47021624a1977b902211b38043ed9f1 perly.y
+ * 5b290f371f373fb17e073f602c676e436e9d457a1d4db67d192e3cfa0eeb36d7 perly.y
* 5c9d2a0262457fe9b70073fc8ad6c188f812f38ad57712b7e2f53daa01b297cc regen_perly.pl
* ex: set ro: */
diff --git a/perly.tab b/perly.tab
index fc94499f32..38cae237b8 100644
--- a/perly.tab
+++ b/perly.tab
@@ -197,12 +197,12 @@ static const yytype_uint16 yyrline[] =
1030, 1037, 1041, 1045, 1050, 1055, 1060, 1069, 1074, 1079,
1085, 1091, 1102, 1106, 1110, 1122, 1135, 1143, 1155, 1156,
1157, 1158, 1159, 1164, 1168, 1170, 1174, 1179, 1181, 1186,
- 1188, 1190, 1192, 1194, 1196, 1198, 1207, 1219, 1230, 1244,
- 1246, 1248, 1253, 1266, 1271, 1276, 1280, 1284, 1288, 1292,
- 1296, 1300, 1304, 1306, 1309, 1313, 1319, 1321, 1326, 1329,
- 1338, 1345, 1344, 1360, 1361, 1362, 1368, 1372, 1380, 1387,
- 1392, 1397, 1399, 1401, 1406, 1408, 1413, 1414, 1420, 1424,
- 1430, 1436, 1442, 1449, 1455, 1462, 1464, 1466, 1469
+ 1188, 1190, 1192, 1194, 1196, 1198, 1210, 1222, 1236, 1250,
+ 1252, 1254, 1259, 1272, 1277, 1282, 1286, 1290, 1294, 1298,
+ 1302, 1306, 1310, 1312, 1315, 1319, 1325, 1327, 1332, 1335,
+ 1344, 1351, 1350, 1366, 1367, 1368, 1374, 1378, 1386, 1393,
+ 1398, 1403, 1405, 1407, 1412, 1414, 1419, 1420, 1426, 1430,
+ 1436, 1442, 1449, 1456, 1462, 1469, 1471, 1473, 1476
};
#endif
@@ -1123,6 +1123,6 @@ static const toketypes yy_type_tab[] =
};
/* Generated from:
- * 80609b739b642fa427503886445869dfd47021624a1977b902211b38043ed9f1 perly.y
+ * 5b290f371f373fb17e073f602c676e436e9d457a1d4db67d192e3cfa0eeb36d7 perly.y
* 5c9d2a0262457fe9b70073fc8ad6c188f812f38ad57712b7e2f53daa01b297cc regen_perly.pl
* ex: set ro: */
diff --git a/perly.y b/perly.y
index 6b196469e4..c48c9b257d 100644
--- a/perly.y
+++ b/perly.y
@@ -1201,6 +1201,9 @@ term : termbinop
newLISTOP(OP_ASLICE, 0,
list($3),
ref($1, OP_ASLICE)));
+ if ($$ && $1)
+ $$->op_private |=
+ $1->op_private & OPpSLICEWARNING;
TOKEN_GETMAD($2,$$,'[');
TOKEN_GETMAD($4,$$,']');
}
@@ -1222,6 +1225,9 @@ term : termbinop
newLISTOP(OP_HSLICE, 0,
list($3),
ref(oopsHV($1), OP_HSLICE)));
+ if ($$ && $1)
+ $$->op_private |=
+ $1->op_private & OPpSLICEWARNING;
PL_parser->expect = XOPERATOR;
TOKEN_GETMAD($2,$$,'{');
TOKEN_GETMAD($4,$$,';');
@@ -1435,6 +1441,7 @@ scalar : '$' indirob
ary : '@' indirob
{ $$ = newAVREF($2);
+ if ($$) $$->op_private |= IVAL($1);
TOKEN_GETMAD($1,$$,'@');
}
;
diff --git a/t/lib/warnings/op b/t/lib/warnings/op
index 10721def8b..bb46eb8d14 100644
--- a/t/lib/warnings/op
+++ b/t/lib/warnings/op
@@ -144,24 +144,40 @@ EXPECT
########
# op.c
use warnings 'syntax' ;
-@a[3] = 2;
-@a{3} = 2;
+@a[3];
+@a{3};
+@a["]"];
+@a{"]"};
+@a["}"];
+@a{"}"};
+@a{$_};
+@a{--$_};
+@a[$_];
+@a[--$_];
no warnings 'syntax' ;
-@a[3] = 2;
-@a{3} = 2;
+@a[3];
+@a{3};
EXPECT
Scalar value @a[3] better written as $a[3] at - line 3.
Scalar value @a{3} better written as $a{3} at - line 4.
+Scalar value @a["]"] better written as $a["]"] at - line 5.
+Scalar value @a{"]"} better written as $a{"]"} at - line 6.
+Scalar value @a["}"] better written as $a["}"] at - line 7.
+Scalar value @a{"}"} better written as $a{"}"} at - line 8.
+Scalar value @a{...} better written as $a{...} at - line 9.
+Scalar value @a{...} better written as $a{...} at - line 10.
+Scalar value @a[...] better written as $a[...] at - line 11.
+Scalar value @a[...] better written as $a[...] at - line 12.
########
# op.c
use utf8;
use open qw( :utf8 :std );
use warnings 'syntax' ;
-@à[3] = 2;
-@à{3} = 2;
+@à[3];
+@à{3};
no warnings 'syntax' ;
-@à[3] = 2;
-@à{3} = 2;
+@à[3];
+@à{3};
EXPECT
Scalar value @à[3] better written as $à[3] at - line 5.
Scalar value @à{3} better written as $à{3} at - line 6.
@@ -170,16 +186,122 @@ Scalar value @à{3} better written as $à{3} at - line 6.
use utf8;
use open qw( :utf8 :std );
use warnings 'syntax' ;
-@ぁ[3] = 2;
-@ぁ{3} = 2;
+@ぁ[3];
+@ぁ{3};
no warnings 'syntax' ;
-@ぁ[3] = 2;
-@ぁ{3} = 2;
+@ぁ[3];
+@ぁ{3};
EXPECT
Scalar value @ぁ[3] better written as $ぁ[3] at - line 5.
Scalar value @ぁ{3} better written as $ぁ{3} at - line 6.
########
# op.c
+# "Scalar value better written as" false positives
+# [perl #28380] and [perl #114024]
+use warnings 'syntax';
+
+# hashes
+@h{qw"a b c"} = 1..3;
+@h{qw'a b c'} = 1..3;
+@h{qw$a b c$} = 1..3;
+@h{qw-a b c-} = 1..3;
+@h{qw#a b c#} = 1..3;
+@h{ qw#a b c#} = 1..3;
+@h{ qw#a b c#} = 1..3; # tab before qw
+@h{qw "a"};
+@h{ qw "a"};
+@h{ qw "a"};
+sub foo() { qw/abc def ghi/ }
+@X{+foo} = ( 1 .. 3 );
+$_ = "abc"; @X{split ""} = ( 1 .. 3 );
+my @s = @f{"}", "a"};
+my @s = @f{"]", "a"};
+@a{$],0};
+@_{0} = /(.*)/;
+@h{m "$re"};
+@h{qx ""} if 0;
+@h{glob ""};
+@h{readline ""};
+@h{m ""};
+use constant phoo => 1..3;
+@h{+phoo}; # rv2av
+{
+ no warnings 'deprecated';
+ @h{each H};
+ @h{values H};
+ @h{keys H};
+}
+@h{sort foo};
+@h{reverse foo};
+@h{caller 0};
+@h{lstat ""};
+@h{stat ""};
+@h{readdir ""};
+@h{system ""} if 0;
+@h{+times} if 0;
+@h{localtime 0};
+@h{gmtime 0};
+@h{eval ""};
+@h{each $foo} if 0;
+@h{keys $foo} if 0;
+@h{values $foo} if 0;
+
+# arrays
+@h[qw"a b c"] = 1..3;
+@h[qw'a b c'] = 1..3;
+@h[qw$a b c$] = 1..3;
+@h[qw-a b c-] = 1..3;
+@h[qw#a b c#] = 1..3;
+@h[ qw#a b c#] = 1..3;
+@h[ qw#a b c#] = 1..3; # tab before qw
+@h[qw "a"];
+@h[ qw "a"];
+@h[ qw "a"];
+sub foo() { qw/abc def ghi/ }
+@X[+foo] = ( 1 .. 3 );
+$_ = "abc"; @X[split ""] = ( 1 .. 3 );
+my @s = @f["}", "a"];
+my @s = @f["]", "a"];
+@a[$],0];
+@_[0] = /(.*)/;
+@h[m "$re"];
+@h[qx ""] if 0;
+@h[glob ""];
+@h[readline ""];
+@h[m ""];
+use constant phoo => 1..3;
+@h[+phoo]; # rv2av
+{
+ no warnings 'deprecated';
+ @h[each H];
+ @h[values H];
+ @h[keys H];
+}
+@h[sort foo];
+@h[reverse foo];
+@h[caller 0];
+@h[lstat ""];
+@h[stat ""];
+@h[readdir ""];
+@h[system ""] if 0;
+@h[+times] if 0;
+@h[localtime 0];
+@h[gmtime 0];
+@h[eval ""];
+@h[each $foo] if 0;
+@h[keys $foo] if 0;
+@h[values $foo] if 0;
+EXPECT
+########
+# op.c
+# "Scalar value better written as" should not trigger for syntax errors
+use warnings 'syntax';
+@a[]
+EXPECT
+syntax error at - line 4, near "[]"
+Execution of - aborted due to compilation errors.
+########
+# op.c
my (@foo, %foo);
%main::foo->{"bar"};
%foo->{"bar"};
diff --git a/toke.c b/toke.c
index 0522852aaf..8cca3f4b2e 100644
--- a/toke.c
+++ b/toke.c
@@ -4682,6 +4682,20 @@ S_word_takes_any_delimeter(char *p, STRLEN len)
(p[0] == 'q' && strchr("qwxr", p[1]))));
}
+static void
+S_check_scalar_slice(pTHX_ char *s)
+{
+ s++;
+ while (*s == ' ' || *s == '\t') s++;
+ if (*s == 'q' && s[1] == 'w'
+ && !isWORDCHAR_lazy_if(s+2,UTF))
+ return;
+ while (*s && (isWORDCHAR_lazy_if(s,UTF) || strchr(" \t$#+-'\"", *s)))
+ s += UTF ? UTF8SKIP(s) : 1;
+ if (*s == '}' || *s == ']')
+ pl_yylval.ival = OPpSLICEWARNING;
+}
+
/*
yylex
@@ -5823,20 +5837,10 @@ Perl_yylex(pTHX)
/* Warn about % where they meant $. */
if (*s == '[' || *s == '{') {
if (ckWARN(WARN_SYNTAX)) {
- const char *t = s + 1;
- while (*t == ' ') t++;
- if (*t == 'q' && t[1] == 'w'
- && !isWORDCHAR_lazy_if(t+2,UTF))
- goto no_qw_warning;
- while (*t && (isWORDCHAR_lazy_if(t,UTF) || strchr(" \t$#+-'\"", *t)))
- t += UTF ? UTF8SKIP(t) : 1;
- if (*t == '}' || *t == ']') {
- pl_yylval.ival = OPpSLICEWARNING;
- }
+ S_check_scalar_slice(aTHX_ s);
}
}
}
- no_qw_warning:
PL_expect = XOPERATOR;
force_ident_maybe_lex('%');
TERM('%');
@@ -6693,6 +6697,7 @@ Perl_yylex(pTHX)
no_op("Array", s);
PL_tokenbuf[0] = '@';
s = scan_ident(s, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE);
+ pl_yylval.ival = 0;
if (!PL_tokenbuf[1]) {
PREREF('@');
}
@@ -6705,18 +6710,7 @@ Perl_yylex(pTHX)
/* Warn about @ where they meant $. */
if (*s == '[' || *s == '{') {
if (ckWARN(WARN_SYNTAX)) {
- const char *t = s + 1;
- while (*t && (isWORDCHAR_lazy_if(t,UTF) || strchr(" \t$#+-'\"", *t)))
- t += UTF ? UTF8SKIP(t) : 1;
- if (*t == '}' || *t == ']') {
- t++;
- PL_bufptr = PEEKSPACE(PL_bufptr); /* XXX can realloc */
- /* diag_listed_as: Scalar value @%s[%s] better written as $%s[%s] */
- Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
- "Scalar value %"UTF8f" better written as $%"UTF8f,
- UTF8fARG(UTF, t-PL_bufptr, PL_bufptr),
- UTF8fARG(UTF, t-PL_bufptr-1, PL_bufptr+1));
- }
+ S_check_scalar_slice(aTHX_ s);
}
}
}