From: Rafael Garcia-Suarez Date: Sat, 2 Feb 2002 22:24:54 +0000 (+0100) Subject: lstat FH and -l FH warnings X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5d3e98def4ec5753a5f78c106401b1351d752266;p=p5sagit%2Fp5-mst-13.2.git lstat FH and -l FH warnings Message-ID: <20020202222454.A11608@rafael> p4raw-id: //depot/perl@14530 --- diff --git a/doio.c b/doio.c index 3c06585..68853c2 100644 --- a/doio.c +++ b/doio.c @@ -1308,13 +1308,22 @@ Perl_my_lstat(pTHX) Perl_croak(aTHX_ "The stat preceding -l _ wasn't an lstat"); return PL_laststatval; } - Perl_croak(aTHX_ "You can't use -l on a filehandle"); + if (ckWARN(WARN_IO)) { + Perl_warner(aTHX_ WARN_IO, "Use of -l on filehandle %s", + GvENAME(cGVOP_gv)); + return (PL_laststatval = -1); + } } PL_laststype = OP_LSTAT; PL_statgv = Nullgv; sv = POPs; PUTBACK; + if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV && ckWARN(WARN_IO)) { + Perl_warner(aTHX_ WARN_IO, "Use of -l on filehandle %s", + GvENAME((GV*) SvRV(sv))); + return (PL_laststatval = -1); + } sv_setpv(PL_statname,SvPV(sv, n_a)); PL_laststatval = PerlLIO_lstat(SvPV(sv, n_a),&PL_statcache); if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n')) diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm index be184a6..5558baf 100644 --- a/lib/File/Copy.pm +++ b/lib/File/Copy.pm @@ -72,6 +72,7 @@ sub copy { if ($Config{d_symlink} && $Config{d_readlink} && !($^O eq 'Win32' || $^O eq 'os2' || $^O eq 'vms')) { + no warnings 'io'; # don't warn if -l on filehandle if ((-e $from && -l $from) || (-e $to && -l $to)) { my @fs = stat($from); my @ts = stat($to); diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 76fb6aa..791b302 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -1846,6 +1846,12 @@ effective uids or gids failed. to check the return value of your socket() call? See L. +=item lstat() on filehandle %s + +(W io) You tried to do an lstat on a filehandle. What did you mean +by that? lstat() makes sense only on filenames. (Perl did a fstat() +instead on the filehandle.) + =item Lvalue subs returning %s not implemented yet (F) Due to limitations in the current implementation, array and hash @@ -3954,6 +3960,12 @@ In code that currently says C you should remove AutoLoader from @ISA and change C to C. +=item Use of -l on filehandle %s + +(W io) A filehandle represents an opened file, and when you opened the file +it already went past any symlink you are presumably trying to look for. +The operation returned C. Use a filename instead. + =item Use of "package" with no arguments is deprecated (D deprecated) You used the C keyword without specifying a package @@ -4208,17 +4220,6 @@ supported. (F) The use of an external subroutine as a sort comparison is not yet supported. -=item You can't use C<-l> on a filehandle - -(F) A filehandle represents an opened file, and when you opened the file -it already went past any symlink you are presumably trying to look for. -Use a filename instead. - -=item You can't use lstat() on a filehandle - -(F) You tried to do an lstat on a filehandle. lstat() makes sense only -on filenames. - =item YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET! (F) And you probably never will, because you probably don't have the diff --git a/pp_sys.c b/pp_sys.c index b1ce18a..4b1a1e7 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -2726,9 +2726,11 @@ PP(pp_stat) if (PL_op->op_flags & OPf_REF) { gv = cGVOP_gv; if (PL_op->op_type == OP_LSTAT) { - if (gv != PL_defgv) - Perl_croak(aTHX_ "You can't use lstat() on a filehandle"); - if (PL_laststype != OP_LSTAT) + if (gv != PL_defgv) { + if (ckWARN(WARN_IO)) + Perl_warner(aTHX_ WARN_IO, + "lstat() on filehandle %s", GvENAME(gv)); + } else if (PL_laststype != OP_LSTAT) Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat"); } @@ -2754,6 +2756,9 @@ PP(pp_stat) } else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) { gv = (GV*)SvRV(sv); + if (PL_op->op_type == OP_LSTAT && ckWARN(WARN_IO)) + Perl_warner(aTHX_ WARN_IO, + "lstat() on filehandle %s", GvENAME(gv)); goto do_fstat; } sv_setpv(PL_statname, SvPV(sv,n_a)); diff --git a/t/lib/warnings/doio b/t/lib/warnings/doio index 9ba4d31..0db1a13 100644 --- a/t/lib/warnings/doio +++ b/t/lib/warnings/doio @@ -36,6 +36,8 @@ warn(warn_nl, "lstat"); [Perl_my_lstat] lstat "ab\ncd" + Use of -l on filehandle %s [Perl_my_lstat] + Can't exec \"%s\": %s [Perl_do_aexec5] Can't exec \"%s\": %s [Perl_do_exec3] @@ -154,6 +156,20 @@ EXPECT Unsuccessful stat on filename containing newline at - line 3. Unsuccessful stat on filename containing newline at - line 4. ######## +# doio.c [Perl_my_stat] +use warnings 'io'; +-l STDIN; +-l $fh; +open $fh, $0 or die "# $!"; +-l $fh; +no warnings 'io'; +-l STDIN; +-l $fh; +close $fh; +EXPECT +Use of -l on filehandle STDIN at - line 3. +Use of -l on filehandle $fh at - line 6. +######## # doio.c [Perl_do_aexec5] use warnings 'io' ; exec "lskdjfalksdjfdjfkls","" ; diff --git a/t/lib/warnings/pp_sys b/t/lib/warnings/pp_sys index 4b9c8b1..57abd69 100644 --- a/t/lib/warnings/pp_sys +++ b/t/lib/warnings/pp_sys @@ -96,8 +96,8 @@ my $file = "./xcv" ; open(F, ">$file") ; my $a = sysread(F, $a,10) ; - - + + lstat on filehandle %s [pp_lstat] __END__ # pp_sys.c [pp_untie] @@ -396,3 +396,16 @@ $a = "BLERG";binmode($a); EXPECT binmode() on unopened filehandle BLARG at - line 3. binmode() on unopened filehandle at - line 4. +######## +# pp_sys.c [pp_lstat] +use warnings 'io'; +lstat STDIN; +open my $fh, $0 or die "# $!"; +lstat $fh; +no warnings 'io'; +lstat STDIN; +lstat $fh; +close $fh; +EXPECT +lstat() on filehandle STDIN at - line 3. +lstat() on filehandle $fh at - line 5. diff --git a/t/op/stat.t b/t/op/stat.t index 6bb3315..312dd1d 100755 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -9,7 +9,7 @@ BEGIN { use Config; use File::Spec; -plan tests => 75; +plan tests => 73; my $Perl = which_perl(); @@ -390,13 +390,6 @@ SKIP: { like( $@, qr/^The stat preceding -l _ wasn't an lstat/, '-l _ croaks after stat' ); - eval { lstat STDIN }; - like( $@, qr/^You can't use lstat\(\) on a filehandle/, - 'lstat FILEHANDLE croaks' ); - eval { -l STDIN }; - like( $@, qr/^You can't use -l on a filehandle/, - '-l FILEHANDLE croaks' ); - # bug id 20020124.004 # If we have d_lstat, we should have symlink() my $linkname = 'dolzero';