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

tonycoz · tonycoz · commit 300daee115d7 · 2024-07-29T11:20:10.000+10:00
Fixes #22394
diff --git a/embed.fnc b/embed.fnc
@@ -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
diff --git 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
@@ -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
diff --git 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
diff --git 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();
