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 (file)
--- 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 (file)
--- 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 (file)
--- 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<perlfunc/listen>.
 
+=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<use AutoLoader; @ISA = qw(AutoLoader);>
 you should remove AutoLoader from @ISA and change C<use AutoLoader;> to
 C<use AutoLoader 'AUTOLOAD';>.
 
+=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<undef>.  Use a filename instead.
+
 =item Use of "package" with no arguments is deprecated
 
 (D deprecated) You used the C<package> 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (executable)
--- 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';