diff options
| -rw-r--r-- | dump.c | 3 | ||||
| -rw-r--r-- | ext/B/B/Concise.pm | 2 | ||||
| -rw-r--r-- | op.c | 90 | ||||
| -rw-r--r-- | op.h | 4 | ||||
| -rw-r--r-- | pod/perldiag.pod | 44 | ||||
| -rw-r--r-- | t/lib/croak/op | 6 | ||||
| -rw-r--r-- | t/op/kvaslice.t | 26 | ||||
| -rw-r--r-- | t/op/kvhslice.t | 27 | ||||
| -rw-r--r-- | toke.c | 7 |
9 files changed, 128 insertions, 81 deletions
@@ -960,8 +960,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) \ + o->op_type == OP_ASLICE || o->op_type == OP_HSLICE) \ && oppriv & OPpSLICEWARNING ) \ sv_catpvs(tmpsv, ",SLICEWARNING"); \ if (SvCUR(tmpsv)) { \ diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index 632cc66678..01769facf1 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -621,7 +621,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 hslice aslice); + for qw(rv2hv rv2av padav padhv hslice aslice); @{$priv{$_}}{32,64} = qw(BOOL BOOL?) for qw(rv2hv padhv); $priv{substr}{16} = "REPL1ST"; $priv{$_}{16} = "TARGMY" @@ -1145,15 +1145,31 @@ S_op_varname(pTHX_ const OP *o) } static void +S_op_pretty(pTHX_ const OP *o, SV **retsv, const char **retpv) +{ /* or not so pretty :-) */ + const char *key = NULL; + if (o->op_type == OP_CONST) { + *retsv = cSVOPo_sv; + if (SvPOK(*retsv)) { + SV *sv = *retsv; + *retsv = sv_newmortal(); + pv_pretty(*retsv, SvPVX_const(sv), SvCUR(sv), 32, NULL, NULL, + PERL_PV_PRETTY_DUMP |PERL_PV_ESCAPE_UNI_DETECT); + } + else if (!SvOK(*retsv)) + *retpv = "undef"; + } + else *retpv = "..."; +} + +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 ? '{' : '['; + 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 ? '@' : '%'; + o->op_type == OP_HSLICE ? '}' : ']'; SV *name; SV *keysv = NULL; /* just to silence compiler warnings */ const char *key = NULL; @@ -1199,33 +1215,22 @@ S_scalar_slice_warning(pTHX_ const OP *o) 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 = "..."; + S_op_pretty(aTHX_ kid, &keysv, &key); assert(SvPOK(name)); sv_chop(name,SvPVX(name)+1); if (key) - /* diag_listed_as: Scalar value %%s[%s] better written as $%s[%s] */ + /* 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 + "Scalar value @%"SVf"%c%s%c better written as $%"SVf "%c%s%c", - funny, SVfARG(name), lbrack, key, rbrack, SVfARG(name), + SVfARG(name), lbrack, key, rbrack, SVfARG(name), lbrack, key, rbrack); else - /* diag_listed_as: Scalar value %%s[%s] better written as $%s[%s] */ + /* 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 $%" + "Scalar value @%"SVf"%c%"SVf"%c better written as $%" SVf"%c%"SVf"%c", - funny, SVfARG(name), lbrack, keysv, rbrack, + SVfARG(name), lbrack, keysv, rbrack, SVfARG(name), lbrack, keysv, rbrack); } @@ -1293,7 +1298,44 @@ Perl_scalar(pTHX_ OP *o) break; case OP_KVHSLICE: case OP_KVASLICE: - S_scalar_slice_warning(aTHX_ o); + { + /* Warn about scalar context */ + const char lbrack = o->op_type == OP_KVHSLICE ? '{' : '['; + const char rbrack = o->op_type == OP_KVHSLICE ? '}' : ']'; + SV *name; + SV *keysv; + const char *key = NULL; + + /* This warning can be nonsensical when there is a syntax error. */ + if (PL_parser && PL_parser->error_count) + break; + + if (!ckWARN(WARN_SYNTAX)) break; + + kid = cLISTOPo->op_first; + kid = kid->op_sibling; /* get past pushmark */ + assert(kid->op_sibling); + name = S_op_varname(aTHX_ kid->op_sibling); + if (!name) /* XS module fiddling with the op tree */ + break; + S_op_pretty(aTHX_ kid, &keysv, &key); + assert(SvPOK(name)); + sv_chop(name,SvPVX(name)+1); + if (key) + /* diag_listed_as: %%s[%s] in scalar context better written as $%s[%s] */ + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), + "%%%"SVf"%c%s%c in scalar context better written " + "as $%"SVf"%c%s%c", + SVfARG(name), lbrack, key, rbrack, SVfARG(name), + lbrack, key, rbrack); + else + /* diag_listed_as: %%s[%s] in scalar context better written as $%s[%s] */ + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), + "%%%"SVf"%c%"SVf"%c in scalar context better " + "written as $%"SVf"%c%"SVf"%c", + SVfARG(name), lbrack, keysv, rbrack, + SVfARG(name), lbrack, keysv, rbrack); + } } return o; } @@ -9011,7 +9053,7 @@ Perl_ck_fun(pTHX_ OP *o) { return too_many_arguments_pv(o,PL_op_desc[type], 0); } - scalar(kid); + if (type != OP_DELETE) scalar(kid); break; case OA_LIST: if (oa < 16) { @@ -250,8 +250,8 @@ is no conversion of op type. #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_[AH]SLICE */ -#define OPpSLICEWARNING 4 /* warn about %hash{$scalar} */ + /* OP_RV2[AH]V 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() */ /* OP_RV2[AGH]V, OP_PAD[AH]V, OP_[AH]ELEM, OP_[AH]SLICE OP_AV2ARYLEN, diff --git a/pod/perldiag.pod b/pod/perldiag.pod index e88646a33d..81eef8e1bc 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -2348,6 +2348,28 @@ C<state ($a) = 42> as C<state $a = 42> to change from list to scalar context. Constructions such as C<state (@a) = foo()> will be supported in a future perl release. +=item %%s[%s] in scalar context better written as $%s[%s] + +(W syntax) In scalar context, you've used an array index/value slice +(indicated by %) to select a single element of an array. Generally +it's better to ask for a scalar value (indicated by $). The difference +is that C<$foo[&bar]> always behaves like a scalar, both in the value it +returns and when evaluating its argument, while C<%foo[&bar]> provides +a list context to its subscript, which can do weird things if you're +expecting only one subscript. When called in list context, it also +returns the index (what C<&bar> returns) in addition to the value. + +=item %%s{%s} in scalar context better written as $%s{%s} + +(W syntax) In scalar context, you've used a hash key/value slice +(indicated by %) to select a single element of a hash. Generally it's +better to ask for a scalar value (indicated by $). The difference +is that C<$foo{&bar}> always behaves like a scalar, both in the value +it returns and when evaluating its argument, while C<@foo{&bar}> and +provides a list context to its subscript, which can do weird things +if you're expecting only one subscript. When called in list context, +it also returns the key in addition to the value. + =item Insecure dependency in %s (F) You tried to do something that the tainting mechanism didn't like. @@ -4626,28 +4648,6 @@ as a list, you need to look into how references work, because Perl will not magically convert between scalars and lists for you. See L<perlref>. -=item Scalar value %%s[%s] better written as $%s[%s] - -(W syntax) In scalar context, you've used an array index/value slice -(indicated by %) to select a single element of an array. Generally -it's better to ask for a scalar value (indicated by $). The difference -is that C<$foo[&bar]> always behaves like a scalar, both in the value it -returns and when evaluating its argument, while C<%foo[&bar]> provides -a list context to its subscript, which can do weird things if you're -expecting only one subscript. When called in list context, it also -returns the index (what C<&bar> returns) in addition to the value. - -=item Scalar value %%s{%s} better written as $%s{%s} - -(W syntax) In scalar context, you've used a hash key/value slice -(indicated by %) to select a single element of a hash. Generally it's -better to ask for a scalar value (indicated by $). The difference -is that C<$foo{&bar}> always behaves like a scalar, both in the value -it returns and when evaluating its argument, while C<@foo{&bar}> and -provides a list context to its subscript, which can do weird things -if you're expecting only one subscript. When called in list context, -it also returns the key in addition to the value. - =item Search pattern not terminated (F) The lexer couldn't find the final delimiter of a // or m{} diff --git a/t/lib/croak/op b/t/lib/croak/op index 31af174804..3ec418ffd4 100644 --- a/t/lib/croak/op +++ b/t/lib/croak/op @@ -48,6 +48,12 @@ delete $x; EXPECT delete argument is not a HASH or ARRAY element or slice at - line 1. ######## +# NAME delete sort +use warnings; +delete sort; # used to warn about scalar context, too +EXPECT +delete argument is not a HASH or ARRAY element or slice at - line 2. +######## # NAME exists BAD exists $x; EXPECT diff --git a/t/op/kvaslice.t b/t/op/kvaslice.t index a1d9388d04..0738a17a87 100644 --- a/t/op/kvaslice.t +++ b/t/op/kvaslice.t @@ -8,7 +8,7 @@ BEGIN { # use strict; -plan tests => 39; +plan tests => 40; # simple use cases { @@ -41,17 +41,19 @@ plan tests => 39; # scalar context { + my @warn; + local $SIG{__WARN__} = sub {push @warn, "@_"}; + my @a = 'a'..'z'; - is scalar %a[4,5,6], 'g', 'last element in scalar context'; + is eval'scalar %a[4,5,6]', 'g', 'last element in scalar context'; - { - my @warn; - local $SIG{__WARN__} = sub {push @warn, "@_"}; - eval 'is( scalar %a[5], "f", "correct value");'; + like ($warn[0], + qr/^\%a\[\.\.\.\] in scalar context better written as \$a\[\.\.\.\]/); - is (scalar @warn, 1); - like ($warn[0], qr/^Scalar value \%a\[5\] better written as \$a\[5\]/); - } + eval 'is( scalar %a[5], "f", "correct value");'; + + is (scalar @warn, 2); + like ($warn[1], qr/^\%a\[5\] in scalar context better written as \$a\[5\]/); } # autovivification @@ -151,7 +153,8 @@ plan tests => 39; @warn = (); my $v = eval '%a[0]'; is (scalar @warn, 1, 'warning in scalar context'); - like $warn[0], qr{^Scalar value %a\[0\] better written as \$a\[0\]}, + like $warn[0], + qr{^%a\[0\] in scalar context better written as \$a\[0\]}, "correct warning text"; } { @@ -179,7 +182,8 @@ plan tests => 39; { my %h = 'a'..'b'; my @i = \%h; - my ($k,$v) = each %i[(0)]; # parens suppress "Scalar better written as" + no warnings 'syntax'; + my ($k,$v) = each %i[0]; is $k, 'a', 'key returned by each %array[ix]'; is $v, 'b', 'val returned by each %array[ix]'; %h = 1..10; diff --git a/t/op/kvhslice.t b/t/op/kvhslice.t index bb0f3c16b9..8acd0ab81c 100644 --- a/t/op/kvhslice.t +++ b/t/op/kvhslice.t @@ -8,7 +8,7 @@ BEGIN { # use strict; -plan tests => 43; +plan tests => 44; # simple use cases { @@ -41,18 +41,20 @@ plan tests => 43; # scalar context { + my @warn; + local $SIG{__WARN__} = sub {push @warn, "@_"}; + my %h = map { $_ => uc $_ } 'a'..'z'; - is scalar %h{'c','d','e'}, 'E', 'last element in scalar context'; + is scalar eval"%h{'c','d','e'}", 'E', 'last element in scalar context'; - { - my @warn; - local $SIG{__WARN__} = sub {push @warn, "@_"}; - eval 'is( scalar %h{i}, "I", "correct value");'; + like ($warn[0], + qr/^\%h\{\.\.\.\} in scalar context better written as \$h\{\.\.\.\}/); - is (scalar @warn, 1); - like ($warn[0], - qr/^Scalar value \%h\{"i"\} better written as \$h\{"i"\}/); - } + eval 'is( scalar %h{i}, "I", "correct value");'; + + is (scalar @warn, 2); + like ($warn[1], + qr/^\%h\{"i"\} in scalar context better written as \$h\{"i"\}/); } # autovivification @@ -149,7 +151,7 @@ plan tests => 43; my $v = eval '%h{a}'; is (scalar @warn, 1, 'warning in scalar context'); like $warn[0], - qr{^Scalar value %h{"a"} better written as \$h{"a"}}, + qr{^%h{"a"} in scalar context better written as \$h{"a"}}, "correct warning text"; } { @@ -193,7 +195,8 @@ plan tests => 43; { my %h = 'a'..'b'; my %i = (foo => \%h); - my ($k,$v) = each %i{foo=>}; # => suppresses "Scalar better written as" + no warnings 'syntax'; + my ($k,$v) = each %i{foo=>}; is $k, 'a', 'key returned by each %hash{key}'; is $v, 'b', 'val returned by each %hash{key}'; %h = 1..10; @@ -5853,13 +5853,6 @@ Perl_yylex(pTHX) if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop) && intuit_more(s)) { if (*s == '[') PL_tokenbuf[0] = '@'; - - /* Warn about % where they meant $. */ - if (*s == '[' || *s == '{') { - if (ckWARN(WARN_SYNTAX)) { - S_check_scalar_slice(aTHX_ s); - } - } } PL_expect = XOPERATOR; force_ident_maybe_lex('%'); |