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.

diff --git a/dump.c b/dump.c
index 881759f..1aa96ce 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 67596ca..f6e1365 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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);
                }
            }
        }