Add warnings for the various other *dir() functions when attempted

on invalid dirhandles.

p4raw-id: //depot/perl@26631

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 6b3ba31..561d243 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1271,6 +1271,11 @@ uses the character values modulus 256 instead, as if you had provided:
 
 (W unopened) You tried to close a filehandle that was never opened.
 
+=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 Code missing after '/'
 
 (F) You had a (sub-)template that ends with a '/'. There must be another
@@ -3450,6 +3455,11 @@ terminates. You might use ^# instead.  See L<perlform>.
 (W syntax) You wrote your assignment operator backwards.  The = must
 always comes 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 Runaway format
 
 (F) Your format contained the ~~ repeat-until-blank sequence, but it
@@ -3526,6 +3536,11 @@ the conditional expression, i.e. C<(foo) ? 0 : 1>.
 (W unopened) You tried to use the seek() or sysseek() function on a
 filehandle that was either never opened or has since been closed.
 
+=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 select not implemented
 
 (F) This machine doesn't implement the select() system call.
@@ -3883,6 +3898,11 @@ for Perl to reach.  Perl is doing you a favor by refusing.
 (W unopened) You tried to use the tell() function on a filehandle that
 was either never opened or has since been closed.
 
+=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 That use of $[ is unsupported
 
 (F) Assignment to C<$[> is now strictly circumscribed, and interpreted

diff --git a/pp_sys.c b/pp_sys.c
index 6a4b34c..4e6c6b7 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -3743,8 +3743,13 @@ PP(pp_telldir)
     GV * const gv = (GV*)POPs;
     register IO * const io = GvIOn(gv);
 
-    if (!io || !IoDIRP(io))
-       goto nope;
+    if (!io || !IoDIRP(io)) {
+        if(ckWARN(WARN_IO)) {
+            Perl_warner(aTHX_ packWARN(WARN_IO),
+               "telldir() attempted on invalid dirhandle %s", GvENAME(gv));
+        }
+        goto nope;
+    }
 
     PUSHi( PerlDir_tell(IoDIRP(io)) );
     RETURN;
@@ -3765,9 +3770,13 @@ PP(pp_seekdir)
     GV * const gv = (GV*)POPs;
     register IO * const io = GvIOn(gv);
 
-    if (!io || !IoDIRP(io))
-       goto nope;
-
+    if (!io || !IoDIRP(io)) {
+       if(ckWARN(WARN_IO)) {
+           Perl_warner(aTHX_ packWARN(WARN_IO),
+                "seekdir() attempted on invalid dirhandle %s", GvENAME(gv));
+        }
+        goto nope;
+    }
     (void)PerlDir_seek(IoDIRP(io), along);
 
     RETPUSHYES;
@@ -3787,9 +3796,13 @@ PP(pp_rewinddir)
     GV * const gv = (GV*)POPs;
     register IO * const io = GvIOn(gv);
 
-    if (!io || !IoDIRP(io))
+    if (!io || !IoDIRP(io)) {
+       if(ckWARN(WARN_IO)) {
+           Perl_warner(aTHX_ packWARN(WARN_IO),
+               "rewinddir() attempted on invalid dirhandle %s", GvENAME(gv));
+       }
        goto nope;
-
+    }
     (void)PerlDir_rewind(IoDIRP(io));
     RETPUSHYES;
 nope:
@@ -3808,9 +3821,13 @@ PP(pp_closedir)
     GV * const gv = (GV*)POPs;
     register IO * const io = GvIOn(gv);
 
-    if (!io || !IoDIRP(io))
-       goto nope;
-
+    if (!io || !IoDIRP(io)) {
+       if(ckWARN(WARN_IO)) {
+           Perl_warner(aTHX_ packWARN(WARN_IO),
+                "closedir() attempted on invalid dirhandle %s", GvENAME(gv));
+        }
+        goto nope;
+    }
 #ifdef VOID_CLOSEDIR
     PerlDir_close(IoDIRP(io));
 #else