mirror/perl
1
0
Fork 0
mirror of https://github.com/Perl/perl5.git synced 2026-01-26 08:38:23 +00:00
Code Issues Packages Projects Releases Wiki Activity

readdir() etc: better warning if called on handle open()ed as file

Browse Source 
Fixes #22394
This commit is contained in:
Tony Cook 2024-07-22 16:41:10 +10:00
parent d6b3d8320c
commit 300daee115
6 changed files with 72 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
embed.fnc
View File

@ -5089,6 +5089,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

1
embed.h
View File

@ -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

39
pod/perldiag.pod
View File

@ -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<s///> 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<defined-or> 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<goto> 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

37
pp_sys.c
View File

@ -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

5
proto.h generated
View File

@ -8102,6 +8102,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)

28
t/op/readdir.t
View File

@ -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();