make "lstat FH" croak

Message-ID: <20020201151250.A738@rafael>

p4raw-id: //depot/perl@14513

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 56b6950..76fb6aa 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1846,12 +1846,6 @@ 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
@@ -4220,6 +4214,11 @@ supported.
 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 d540535..b1ce18a 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -2726,12 +2726,10 @@ 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)
                Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat");
-           if (ckWARN(WARN_IO) && gv != PL_defgv)
-               Perl_warner(aTHX_ WARN_IO,
-                       "lstat() on filehandle %s", GvENAME(gv));
-               /* Perl_my_lstat (-l) croak's on filehandle, why warn here? */
        }
 
       do_fstat:

diff --git a/t/op/stat.t b/t/op/stat.t
index 81fd74f..ad87c25 100755 (executable)
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -9,7 +9,7 @@ BEGIN {
 use Config;
 use File::Spec;
 
-plan tests => 74;
+plan tests => 75;
 
 my $Perl = which_perl();
 
@@ -384,15 +384,18 @@ SKIP: {
 
     stat $0;
     eval { lstat _ };
-    ok( $@ =~ /^The stat preceding lstat\(\) wasn't an lstat/,
+    like( $@, qr/^The stat preceding lstat\(\) wasn't an lstat/,
        'lstat _ croaks after stat' );
     eval { -l _ };
-    ok( $@ =~ /^The stat preceding -l _ wasn't an lstat/,
+    like( $@, qr/^The stat preceding -l _ wasn't an lstat/,
        '-l _ croaks after stat' );
 
     eval { lstat STDIN };
-    ok( $@ =~ /^The stat preceding lstat\(\) wasn't an lstat/,
+    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()
@@ -401,10 +404,10 @@ SKIP: {
     lstat $linkname;
     -T _;
     eval { lstat _ };
-    ok( $@ =~ /^The stat preceding lstat\(\) wasn't an lstat/,
+    like( $@, qr/^The stat preceding lstat\(\) wasn't an lstat/,
        'lstat croaks after -T _' );
     eval { -l _ };
-    ok( $@ =~ /^The stat preceding -l _ wasn't an lstat/,
+    like( $@, qr/^The stat preceding -l _ wasn't an lstat/,
        '-l _ croaks after -T _' );
     unlink $linkname or print "# unlink $linkname failed: $!\n";
 }