In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/637494ac7ab11f737c47bf95a2c3a27ef1117984?hp=45d40326f89400e722587fa76ee587404ef594f9>
- Log ----------------------------------------------------------------- commit 637494ac7ab11f737c47bf95a2c3a27ef1117984 Author: Tony Cook <[email protected]> Date: Thu Mar 31 11:18:53 2016 +1100 (perl #126162) improve stat @array handling - warn on lexical arrays too - limit the warning to under C<use warnings 'syntax';> - test the warnings - include the (correct) variable name where possible M op.c M pod/perldiag.pod M t/lib/warnings/op commit edc12fc2e5a216570d2b0ec0b1e83a00822120b5 Author: Tony Cook <[email protected]> Date: Thu Mar 31 10:40:25 2016 +1100 error messages vary between platforms, use errno values instead M t/op/stat.t commit 3c3c69d86c41a658a1d80f5e024b9f8e0b7b425a Author: Tony Cook <[email protected]> Date: Wed Mar 30 16:48:40 2016 +1100 add the new stat(@array) diagnostic to perldiag M pod/perldiag.pod commit 8f6eb0aa5efb953e32803878cca6d9c1e28ac03f Author: Dan Collins <[email protected]> Date: Wed Mar 30 16:42:39 2016 +1100 (perl #126162) warn if stat() is called on an array M op.c M t/op/stat.t ----------------------------------------------------------------------- Summary of changes: op.c | 27 ++++++++++++++++++++++++--- pod/perldiag.pod | 5 +++++ t/lib/warnings/op | 17 +++++++++++++++++ t/op/stat.t | 17 ++++++++++++++++- 4 files changed, 62 insertions(+), 4 deletions(-) diff --git a/op.c b/op.c index e58f711..fcb1bc6 100644 --- a/op.c +++ b/op.c @@ -109,6 +109,8 @@ recursive, but it's recursive on basic blocks, not on tree nodes. #define CALL_RPEEP(o) PL_rpeepp(aTHX_ o) #define CALL_OPFREEHOOK(o) if (PL_opfreehook) PL_opfreehook(aTHX_ o) +static char array_passed_to_stat[] = "Array passed to stat will be coerced to a scalar"; + /* Used to avoid recursion through the op tree in scalarvoid() and op_free() */ @@ -1548,7 +1550,7 @@ S_scalarboolean(pTHX_ OP *o) } static SV * -S_op_varname(pTHX_ const OP *o) +S_op_varname_subscript(pTHX_ const OP *o, int subscript_type) { assert(o); assert(o->op_type == OP_PADAV || o->op_type == OP_RV2AV || @@ -1561,13 +1563,19 @@ S_op_varname(pTHX_ const OP *o) if (cUNOPo->op_first->op_type != OP_GV || !(gv = cGVOPx_gv(cUNOPo->op_first))) return NULL; - return varname(gv, funny, 0, NULL, 0, 1); + return varname(gv, funny, 0, NULL, 0, subscript_type); } return - varname(MUTABLE_GV(PL_compcv), funny, o->op_targ, NULL, 0, 1); + varname(MUTABLE_GV(PL_compcv), funny, o->op_targ, NULL, 0, subscript_type); } } +static SV * +S_op_varname(pTHX_ const OP *o) +{ + return S_op_varname_subscript(aTHX_ o, 1); +} + static void S_op_pretty(pTHX_ const OP *o, SV **retsv, const char **retpv) { /* or not so pretty :-) */ @@ -9733,6 +9741,19 @@ Perl_ck_ftst(pTHX_ OP *o) op_free(o); return newop; } + + if ((kidtype == OP_RV2AV || kidtype == OP_PADAV) && ckWARN(WARN_SYNTAX)) { + SV *name = S_op_varname_subscript(aTHX_ (OP*)kid, 2); + if (name) { + /* diag_listed_as: Array passed to stat will be coerced to a scalar%s */ + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%s (did you want stat %" SVf "?)", + array_passed_to_stat, name); + } + else { + /* diag_listed_as: Array passed to stat will be coerced to a scalar%s */ + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), array_passed_to_stat); + } + } scalar((OP *) kid); if ((PL_hints & HINT_FILETEST_ACCESS) && OP_IS_FILETEST_ACCESS(o->op_type)) o->op_private |= OPpFT_ACCESS; diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 777226f..78aeb16 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -216,6 +216,11 @@ operator which expects either a number or a string matching C</^[a-zA-Z]*[0-9]*\z/>. See L<perlop/Auto-increment and Auto-decrement> for details. +=item Array passed to stat will be coerced to a scalar%s + +(W syntax) You called stat() on an array, but the array will be +coerced to a scalar - the number of elements in the array. + =item assertion botched: %s (X) The malloc package that comes with Perl had an internal failure. diff --git a/t/lib/warnings/op b/t/lib/warnings/op index 8256c23..528639e 100644 --- a/t/lib/warnings/op +++ b/t/lib/warnings/op @@ -2040,3 +2040,20 @@ EXPECT Non-finite repeat count does nothing at - line 5. Non-finite repeat count does nothing at - line 6. Non-finite repeat count does nothing at - line 7. +######## +# NAME warn on stat @array +@foo = ("op/stat.t"); +stat @foo; +my @bar = @foo; +stat @bar; +my $ref = \@foo; +stat @$ref; +use warnings 'syntax'; +stat @foo; +stat @bar; +stat @$ref; +EXPECT +Array passed to stat will be coerced to a scalar (did you want stat $foo[0]?) at - line 8. +Array passed to stat will be coerced to a scalar (did you want stat $bar[0]?) at - line 9. +Array passed to stat will be coerced to a scalar at - line 10. + diff --git a/t/op/stat.t b/t/op/stat.t index 2d7e3c7..637a902 100644 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -25,7 +25,7 @@ if ($^O eq 'MSWin32') { ${^WIN32_SLOPPY_STAT} = 0; } -plan tests => 116; +plan tests => 118; my $Perl = which_perl(); @@ -636,6 +636,21 @@ SKIP: { is join("-", 1,2,3,(stat stat stat),4,5,6), "1-2-3-4-5-6", 'stat inside stat gets scalar context'; +# [perl #126162] stat an array should not work +my $Errno_loaded = eval { require Errno }; +my $statfile = './op/stat.t'; +my @statarg = ($statfile, $statfile); +ok !stat(@statarg), + 'stat on an array of valid paths should warn and should not return any data'; +my $error = 0+$!; +SKIP: +{ + skip "Errno not available", 1 + unless $Errno_loaded; + is $error, &Errno::ENOENT, + 'stat on an array of valid paths should return ENOENT'; +} + END { chmod 0666, $tmpfile; unlink_all $tmpfile; -- Perl5 Master Repository
