From cd22fad3cbcea929e5998c8cd6d89ca3108f2aa5 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@cpan.org>
Date: Tue, 7 May 2013 18:10:17 -0400
Subject: Restore the warning previously issued by (-l $fh)

This is a partial reversion of 433644eed8, which removed a
secondary, short-circuiting behavior when the warning was issued.

Now, the warning is issued, but the normal behavior (treat the
handle as a string) is maintained.  This work was done after
subsequent refactoring to doio.c, so it couldn't be just a
reversion with the "return" statement removed.
---
 doio.c              | 9 +++++++--
 t/lib/warnings/doio | 6 ++++++
 t/op/filetest.t     | 9 ++++++---
 3 files changed, 19 insertions(+), 5 deletions(-)

diff --git a/doio.c b/doio.c
index 4e8d48aa40..56c10198b1 100644
--- a/doio.c
+++ b/doio.c
@@ -1336,6 +1336,7 @@ Perl_my_lstat_flags(pTHX_ const U32 flags)
     static const char* const no_prev_lstat = "The stat preceding -l _ wasn't an lstat";
     dSP;
     const char *file;
+    SV* const sv = TOPs;
     if (PL_op->op_flags & OPf_REF) {
 	if (cGVOP_gv == PL_defgv) {
 	    if (PL_laststype != OP_LSTAT)
@@ -1355,11 +1356,15 @@ Perl_my_lstat_flags(pTHX_ const U32 flags)
       if (PL_laststype != OP_LSTAT)
 	Perl_croak(aTHX_ no_prev_lstat);
       return PL_laststatval;
-    } 
+    }
 
     PL_laststype = OP_LSTAT;
     PL_statgv = NULL;
-    file = SvPV_flags_const_nolen(TOPs, flags);
+    if (SvROK(sv) && isGV_with_GP(SvRV(sv)) && ckWARN(WARN_IO)) {
+        Perl_warner(aTHX_ packWARN(WARN_IO), "Use of -l on filehandle %s",
+           GvENAME((const GV *)SvRV(sv)));
+    }
+    file = SvPV_flags_const_nolen(sv, flags);
     sv_setpv(PL_statname,file);
     PL_laststatval = PerlLIO_lstat(file,&PL_statcache);
     if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(file, '\n'))
diff --git a/t/lib/warnings/doio b/t/lib/warnings/doio
index 732f66d318..37b55e3e77 100644
--- a/t/lib/warnings/doio
+++ b/t/lib/warnings/doio
@@ -159,10 +159,16 @@ 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_my_stat]
 use utf8;
diff --git a/t/op/filetest.t b/t/op/filetest.t
index 9ab049f49b..8878400d9a 100644
--- a/t/op/filetest.t
+++ b/t/op/filetest.t
@@ -9,7 +9,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan(tests => 49 + 27*14);
+plan(tests => 50 + 27*14);
 
 # Tests presume we are in t/op directory and that file 'TEST' is found
 # therein.
@@ -98,9 +98,9 @@ like $@, qr/^The stat preceding -l _ wasn't an lstat at /,
 # t/TEST can be a symlink under -Dmksymlinks, so use our temporary file.
 SKIP: {
  use Perl::OSType 'os_type';
- if (os_type ne 'Unix') { skip "Not Unix", 2 }
+ if (os_type ne 'Unix') { skip "Not Unix", 3 }
  chomp(my $ln = `which ln`);
- if ( ! -e $ln ) { skip "No ln"   , 2 }
+ if ( ! -e $ln ) { skip "No ln"   , 3 }
  lstat $ro_empty_file;
  `ln -s $ro_empty_file 1`;
  isnt(-l -e _, 1, 'stacked -l uses previous stat, not previous retval');
@@ -111,7 +111,10 @@ SKIP: {
  # -l always treats a non-bareword argument as a file name
  system 'ln', '-s', $ro_empty_file, \*foo;
  local $^W = 1;
+ my @warnings;
+ local $SIG{__WARN__} = sub { push @warnings, @_ };
  is(-l \*foo, 1, '-l \*foo is a file name');
+ ok($warnings[0] =~ /-l on filehandle foo/, 'warning for -l $handle');
  unlink \*foo;
 }
 
-- 
cgit v1.2.1