diff --git a/embed.fnc b/embed.fnc index c0a493e1d574..e5b0dd3917ed 100644 --- a/embed.fnc +++ b/embed.fnc @@ -5086,6 +5086,8 @@ S |OP * |doform |NN CV *cv \ |NULLOK OP *retop S |SV * |space_join_names_mortal \ |NULLOK char * const *array +S |void |warn_not_dirhandle \ + |NN GV *gv # if !defined(HAS_MKDIR) || !defined(HAS_RMDIR) RS |int |dooneliner |NN const char *cmd \ |NN const char *filename diff --git a/embed.h b/embed.h index 8f3614443e41..f99038b2e5ea 100644 --- a/embed.h +++ b/embed.h @@ -1596,6 +1596,7 @@ # if defined(PERL_IN_PP_SYS_C) # define doform(a,b,c) S_doform(aTHX_ a,b,c) # define space_join_names_mortal(a) S_space_join_names_mortal(aTHX_ a) +# define warn_not_dirhandle(a) S_warn_not_dirhandle(aTHX_ a) # if !defined(HAS_MKDIR) || !defined(HAS_RMDIR) # define dooneliner(a,b) S_dooneliner(aTHX_ a,b) # endif diff --git a/pod/perldiag.pod b/pod/perldiag.pod index c2cec95349dc..8e5d8d46beb7 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -674,6 +674,20 @@ version. (F) A subroutine invoked from an external package via call_sv() exited by calling exit. +=item %s() attempted on invalid dirhandle %s + +(W io) You called readdir(), telldir(), seekdir(), rewinddir() or +closedir() on a handle that has not been opened, or is now closed. A +handle must be successfully opened with opendir() to be used with +these functions. Check your control flow. + +=item %s() attempted on handle %s opened with open() + +(W io) You called readdir(), telldir(), seekdir(), rewinddir() or +closedir() on a handle that was opened with open(). If you want to +use these functions to traverse the contents of a directory, you need +to open the handle with opendir(). + =item %s() called too early to check prototype (W prototype) You've called a function that has a prototype before the @@ -1883,11 +1897,6 @@ keyword. (F) Creating a new thread inside the C operator is not supported. -=item closedir() attempted on invalid dirhandle %s - -(W io) The dirhandle you tried to close is either closed or not really -a dirhandle. Check your control flow. - =item close() on unopened filehandle %s (W unopened) You tried to close a filehandle that was never opened. @@ -5646,11 +5655,6 @@ range, and at least one of the end points is a decimal digit. Under the stricter rules, when this happens, both end points should be digits in the same group of 10 consecutive digits. -=item readdir() attempted on invalid dirhandle %s - -(W io) The dirhandle you're reading from is either closed or not really -a dirhandle. Check your control flow. - =item readline() on closed filehandle %s (W closed) The filehandle you're reading from got itself closed sometime @@ -5851,11 +5855,6 @@ for the character. (W syntax) You wrote your assignment operator backwards. The = must always come last, to avoid ambiguity with subsequent unary operators. -=item rewinddir() attempted on invalid dirhandle %s - -(W io) The dirhandle you tried to do a rewinddir() on is either closed -or not really a dirhandle. Check your control flow. - =item Scalars leaked: %d (S internal) Something went wrong in Perl's internal bookkeeping @@ -5905,11 +5904,6 @@ construct, not just the empty search pattern. Therefore code written in Perl 5.10.0 or later that uses the // as the I can be misparsed by pre-5.10.0 Perls as a non-terminated search pattern. -=item seekdir() attempted on invalid dirhandle %s - -(W io) The dirhandle you are doing a seekdir() on is either closed or not -really a dirhandle. Check your control flow. - =item %sseek() on unopened filehandle (W unopened) You tried to use the seek() or sysseek() function on a @@ -6494,11 +6488,6 @@ know about your kind of stdio. You'll have to use a filename instead. (F) You tried to use C to reach a label that was too deeply nested for Perl to reach. Perl is doing you a favor by refusing. -=item telldir() attempted on invalid dirhandle %s - -(W io) The dirhandle you tried to telldir() is either closed or not really -a dirhandle. Check your control flow. - =item tell() on unopened filehandle (W unopened) You tried to use the tell() function on a filehandle that diff --git a/pp_sys.c b/pp_sys.c index ead34bd81726..80e01518aa4d 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -4285,6 +4285,23 @@ PP_wrapped(pp_open_dir, 2, 0) #endif } +static void +S_warn_not_dirhandle(pTHX_ GV *gv) { + IO *io = GvIOn(gv); + + if (IoIFP(io)) { + Perl_ck_warner(aTHX_ packWARN(WARN_IO), + "%s() attempted on handle %" HEKf + " opened with open()", + OP_DESC(PL_op), HEKfARG(GvENAME_HEK(gv))); + } + else { + Perl_ck_warner(aTHX_ packWARN(WARN_IO), + "%s() attempted on invalid dirhandle %" HEKf, + OP_DESC(PL_op), HEKfARG(GvENAME_HEK(gv))); + } +} + PP_wrapped(pp_readdir, 1, 0) { #if !defined(Direntry_t) || !defined(HAS_READDIR) @@ -4302,9 +4319,7 @@ PP_wrapped(pp_readdir, 1, 0) IO * const io = GvIOn(gv); if (!IoDIRP(io)) { - Perl_ck_warner(aTHX_ packWARN(WARN_IO), - "readdir() attempted on invalid dirhandle %" HEKf, - HEKfARG(GvENAME_HEK(gv))); + warn_not_dirhandle(gv); goto nope; } @@ -4352,9 +4367,7 @@ PP_wrapped(pp_telldir, 1, 0) IO * const io = GvIOn(gv); if (!IoDIRP(io)) { - Perl_ck_warner(aTHX_ packWARN(WARN_IO), - "telldir() attempted on invalid dirhandle %" HEKf, - HEKfARG(GvENAME_HEK(gv))); + warn_not_dirhandle(gv); goto nope; } @@ -4378,9 +4391,7 @@ PP_wrapped(pp_seekdir, 2, 0) IO * const io = GvIOn(gv); if (!IoDIRP(io)) { - Perl_ck_warner(aTHX_ packWARN(WARN_IO), - "seekdir() attempted on invalid dirhandle %" HEKf, - HEKfARG(GvENAME_HEK(gv))); + warn_not_dirhandle(gv); goto nope; } (void)PerlDir_seek(IoDIRP(io), along); @@ -4403,9 +4414,7 @@ PP_wrapped(pp_rewinddir, 1, 0) IO * const io = GvIOn(gv); if (!IoDIRP(io)) { - Perl_ck_warner(aTHX_ packWARN(WARN_IO), - "rewinddir() attempted on invalid dirhandle %" HEKf, - HEKfARG(GvENAME_HEK(gv))); + warn_not_dirhandle(gv); goto nope; } (void)PerlDir_rewind(IoDIRP(io)); @@ -4427,9 +4436,7 @@ PP_wrapped(pp_closedir, 1, 0) IO * const io = GvIOn(gv); if (!IoDIRP(io)) { - Perl_ck_warner(aTHX_ packWARN(WARN_IO), - "closedir() attempted on invalid dirhandle %" HEKf, - HEKfARG(GvENAME_HEK(gv))); + warn_not_dirhandle(gv); goto nope; } #ifdef VOID_CLOSEDIR diff --git a/proto.h b/proto.h index c6930fda4c13..73e988ba4cb1 100644 --- a/proto.h +++ b/proto.h @@ -8063,6 +8063,11 @@ STATIC SV * S_space_join_names_mortal(pTHX_ char * const *array); # define PERL_ARGS_ASSERT_SPACE_JOIN_NAMES_MORTAL +STATIC void +S_warn_not_dirhandle(pTHX_ GV *gv); +# define PERL_ARGS_ASSERT_WARN_NOT_DIRHANDLE \ + assert(gv) + # if !defined(HAS_MKDIR) || !defined(HAS_RMDIR) STATIC int S_dooneliner(pTHX_ const char *cmd, const char *filename) diff --git a/t/op/readdir.t b/t/op/readdir.t index 497f55108aa6..b78ea582c79e 100644 --- a/t/op/readdir.t +++ b/t/op/readdir.t @@ -86,4 +86,32 @@ SKIP: is($errno, 0, "errno preserved"); } +SKIP: +{ + open my $fh, "<", "op" + or skip "can't open a directory on this platform", 10; + my $warned; + local $SIG{__WARN__} = sub { $warned = "@_" }; + ok(!readdir($fh), "cannot readdir file handle"); + like($warned, qr/readdir\(\) attempted on handle \$fh opened with open/, + "check the message"); + undef $warned; + ok(!telldir($fh), "cannot telldir file handle"); + like($warned, qr/telldir\(\) attempted on handle \$fh opened with open/, + "check the message"); + undef $warned; + ok(!seekdir($fh, 0), "cannot seekdir file handle"); + like($warned, qr/seekdir\(\) attempted on handle \$fh opened with open/, + "check the message"); + undef $warned; + ok(!rewinddir($fh), "cannot rewinddir file handle"); + like($warned, qr/rewinddir\(\) attempted on handle \$fh opened with open/, + "check the message"); + undef $warned; + ok(!closedir($fh), "cannot closedir file handle"); + like($warned, qr/closedir\(\) attempted on handle \$fh opened with open/, + "check the message"); + undef $warned; +} + done_testing();