Change 29799 by [EMAIL PROTECTED] on 2007/01/13 23:25:00
Integrate:
[ 26602]
Bad symbols that are pretending to be dirhandles, should say they
are dirhandles in their error messages.
[ 26607]
perldiag.pod additions to go with change #26602.
[ 26617]
Attemting to readdir() something that isn't a dirhandle should cause
a warning.
[ 26631]
Add warnings for the various other *dir() functions when attempted
on invalid dirhandles.
[ 26638]
Don't warn about invalid dirhandles in DirHandle::DESTROY().
Affected files ...
... //depot/maint-5.8/perl/gv.c#77 integrate
... //depot/maint-5.8/perl/lib/DirHandle.pm#2 integrate
... //depot/maint-5.8/perl/pod/perldiag.pod#92 integrate
... //depot/maint-5.8/perl/pp_sys.c#118 integrate
Differences ...
==== //depot/maint-5.8/perl/gv.c#77 (text) ====
Index: perl/gv.c
--- perl/gv.c#76~29794~ 2007-01-13 11:26:17.000000000 -0800
+++ perl/gv.c 2007-01-13 15:25:00.000000000 -0800
@@ -73,8 +73,21 @@
GV *
Perl_gv_IOadd(pTHX_ register GV *gv)
{
- if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
- Perl_croak(aTHX_ "Bad symbol for filehandle");
+ if (!gv || SvTYPE((SV*)gv) != SVt_PVGV) {
+
+ /*
+ * if it walks like a dirhandle, then let's assume that
+ * this is a dirhandle.
+ */
+ const char *fh = PL_op->op_type == OP_READDIR ||
+ PL_op->op_type == OP_TELLDIR ||
+ PL_op->op_type == OP_SEEKDIR ||
+ PL_op->op_type == OP_REWINDDIR ||
+ PL_op->op_type == OP_CLOSEDIR ?
+ "dirhandle" : "filehandle";
+ Perl_croak(aTHX_ "Bad symbol for %s", fh);
+ }
+
if (!GvIOp(gv)) {
#ifdef GV_UNIQUE_CHECK
if (GvUNIQUE(gv)) {
==== //depot/maint-5.8/perl/lib/DirHandle.pm#2 (text) ====
Index: perl/lib/DirHandle.pm
--- perl/lib/DirHandle.pm#1~17645~ 2002-07-19 12:29:57.000000000 -0700
+++ perl/lib/DirHandle.pm 2007-01-13 15:25:00.000000000 -0800
@@ -1,6 +1,6 @@
package DirHandle;
-our $VERSION = '1.00';
+our $VERSION = '1.01';
=head1 NAME
@@ -58,6 +58,9 @@
sub DESTROY {
my ($dh) = @_;
+ # Don't warn about already being closed as it may have been closed
+ # correctly, or maybe never opened at all.
+ no warnings 'io';
closedir($dh);
}
==== //depot/maint-5.8/perl/pod/perldiag.pod#92 (text) ====
Index: perl/pod/perldiag.pod
--- perl/pod/perldiag.pod#91~29783~ 2007-01-13 08:30:48.000000000 -0800
+++ perl/pod/perldiag.pod 2007-01-13 15:25:00.000000000 -0800
@@ -367,6 +367,12 @@
(P) An internal request asked to add an array entry to something that
wasn't a symbol table entry.
+=item Bad symbol for dirhandle
+
+(P) An internal request asked to add a dirhandle entry to something
+that wasn't a symbol table entry.
+
+
=item Bad symbol for filehandle
(P) An internal request asked to add a filehandle entry to something
@@ -1219,6 +1225,11 @@
(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
@@ -3259,6 +3270,11 @@
One possible workaround is to force Perl to use magical string increment
by prepending "0" to your numbers.
+=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
@@ -3351,6 +3367,11 @@
(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
@@ -3427,6 +3448,11 @@
(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.
@@ -3773,6 +3799,11 @@
(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
==== //depot/maint-5.8/perl/pp_sys.c#118 (text) ====
Index: perl/pp_sys.c
--- perl/pp_sys.c#117~29787~ 2007-01-13 09:24:48.000000000 -0800
+++ perl/pp_sys.c 2007-01-13 15:25:00.000000000 -0800
@@ -3706,8 +3706,13 @@
register const Direntry_t *dp;
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),
+ "readdir() attempted on invalid dirhandle %s", GvENAME(gv));
+ }
+ goto nope;
+ }
do {
dp = (Direntry_t *)PerlDir_read(IoDIRP(io));
@@ -3755,8 +3760,13 @@
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;
@@ -3777,9 +3787,13 @@
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;
@@ -3799,9 +3813,13 @@
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:
@@ -3820,9 +3838,13 @@
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
End of Patch.
