(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)) { \
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"
}
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;
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);
}
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;
}
{
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) {
#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,
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.
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{}
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
# use strict;
-plan tests => 39;
+plan tests => 40;
# simple use cases
{
# 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
@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";
}
{
{
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;
# use strict;
-plan tests => 43;
+plan tests => 44;
# simple use cases
{
# 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
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";
}
{
{
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;
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('%');
projects / platform / upstream / perl.git / commitdiff