From 429a25554a608b64c0ee46c1ffe19bab3718a3c8 Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Sat, 14 Sep 2013 17:23:11 -0700 Subject: [PATCH] Reduce false positives for @hsh{$s} and @ary[$s] warnings MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit 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. --- dump.c | 1 + ext/B/B/Concise.pm | 2 +- op.c | 146 ++++++++++++++++++++++++++++++++++------------------- op.h | 2 +- perly.act | 109 ++++++++++++++++++++------------------- perly.h | 2 +- perly.tab | 14 ++--- perly.y | 7 +++ t/lib/warnings/op | 146 ++++++++++++++++++++++++++++++++++++++++++++++++----- toke.c | 40 +++++++-------- 10 files changed, 321 insertions(+), 148 deletions(-) diff --git a/dump.c b/dump.c index 881759f..1aa96ce 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 4039954..c644d30 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 a70deb7..c7626e3 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 f491e2e..3978acd 100644 --- a/op.h +++ b/op.h @@ -221,7 +221,7 @@ Deprecated. Use C 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 67596ca..f6e1365 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 155dea0..3b708a8 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 fc94499..38cae23 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 6b19646..c48c9b2 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 10721de..bb46eb8 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 0522852..8cca3f4 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); } } } -- 2.7.4