Perl 5.16 regression: lost warning for -l on filehandle

[p5pRT]

Migrated from rt.perl.org#117595 (status was 'resolved')

Searchable as RT117595$

[p5pRT]

From @xdg

I found a regression bug in Perl.

Up to Perl 5.16, use of "-l" on a file (or directory) handle would
issue a warning​:

  Use of -l on filehandle %s

That warning is no longer issued in Perl 5.16

Test file attached.

David

--
David Golden <xdg@​xdg.me>
Take back your inbox! → http​://www.bunchmail.com/
Twitter/IRC​: @​xdg

[p5pRT]

From @xdg

bug.pl

[p5pRT]

From @b2gills

On Sat Apr 13 01​:38​:38 2013, xdg@​xdg.me wrote​:

I found a regression bug in Perl.

Up to Perl 5.16, use of "-l" on a file (or directory) handle would
issue a warning​:

Use of \-l on filehandle %s

That warning is no longer issued in Perl 5.16

Presumably this is because of some bug fixes related to -l
http​://perldoc.perl.org/perl5160delta.html#Filetests-and-stat

Based on the commit message it may be related to
http​://perl5.git.perl.org/perl.git/commit/433644eed8ac93495dfaad947c1503
ce219b414b

At any rate here is a example program which shows that it is now using
the filehandle as a string, and then using that as a filename​:

  use strict;
  use warnings;

  open my $fh, '<', $0;
  `ln -s test.pl '$fh'`;
  my $is = -l $fh ? 'is' : 'is not';
  print qq["$fh" $is a symlink\n];
  $is = -l $fh ? 'is' : 'is not';
  print qq["$fh" $is a symlink\n];
  1 while unlink ''.$fh;
  close $fh;

On 5.14 it says

  Use of -l on filehandle $fh at test.pl line 7.
  "GLOB(0x2662868)" is not a symlink
  "GLOB(0x2662868)" is a symlink

on 5.16 it says

  "GLOB(0x25f4938)" is a symlink
  "GLOB(0x25f4938)" is a symlink

[p5pRT]

From [Unknown Contact. See original ticket]

On Sat Apr 13 01​:38​:38 2013, xdg@​xdg.me wrote​:

I found a regression bug in Perl.

Up to Perl 5.16, use of "-l" on a file (or directory) handle would
issue a warning​:

Use of \-l on filehandle %s

That warning is no longer issued in Perl 5.16

Presumably this is because of some bug fixes related to -l
http​://perldoc.perl.org/perl5160delta.html#Filetests-and-stat

Based on the commit message it may be related to
http​://perl5.git.perl.org/perl.git/commit/433644eed8ac93495dfaad947c1503
ce219b414b

At any rate here is a example program which shows that it is now using
the filehandle as a string, and then using that as a filename​:

  use strict;
  use warnings;

  open my $fh, '<', $0;
  `ln -s test.pl '$fh'`;
  my $is = -l $fh ? 'is' : 'is not';
  print qq["$fh" $is a symlink\n];
  $is = -l $fh ? 'is' : 'is not';
  print qq["$fh" $is a symlink\n];
  1 while unlink ''.$fh;
  close $fh;

On 5.14 it says

  Use of -l on filehandle $fh at test.pl line 7.
  "GLOB(0x2662868)" is not a symlink
  "GLOB(0x2662868)" is a symlink

on 5.16 it says

  "GLOB(0x25f4938)" is a symlink
  "GLOB(0x25f4938)" is a symlink

[p5pRT]

From @xdg

On Sat, Apr 13, 2013 at 4​:14 PM, Brad Gilbert via RT
<perlbug-comment@​perl.org> wrote​:

Based on the commit message it may be related to
http​://perl5.git.perl.org/perl.git/commit/433644eed8ac93495dfaad947c1503
ce219b414b

Based on the commit message, that's pretty clearly the wrong fix​:

Historical behavior of C<-l $handle>​:

  5.6​: treat as filename

  5.8 to 5.14​:
  - without warnings​: treat as filename
  - with warnings​: return undef and warn

  5.16​: treat as filename

The desired behavior would seem to be​:
  - without warnings​: return undef
  - with warnings​: return undef and warn

[p5pRT]

From @xdg

Here is a patch for blead Perl with tests, but part of it is a bit
crude. -l on filehandles should warn *unless* there is string
overloading on the handle. I wrote the patch with SvGAMAGIC, but it
really should be more specific to string overloading and I don't know
how to do that in XS/C.

So someone more wizardly than I should tweak this before it gets applied.

David

On Sun, Apr 14, 2013 at 2​:07 AM, David Golden <xdg@​xdg.me> wrote​:

On Sat, Apr 13, 2013 at 4​:14 PM, Brad Gilbert via RT
<perlbug-comment@​perl.org> wrote​:

Based on the commit message it may be related to
http​://perl5.git.perl.org/perl.git/commit/433644eed8ac93495dfaad947c1503
ce219b414b

Based on the commit message, that's pretty clearly the wrong fix​:

Historical behavior of C<-l $handle>​:

5\.6​: treat as filename

5\.8 to 5\.14​:
    \- without warnings​: treat as filename
    \- with warnings​: return undef and warn

5\.16​: treat as filename

The desired behavior would seem to be​:
- without warnings​: return undef
- with warnings​: return undef and warn

--
David Golden <xdg@​xdg.me>
Take back your inbox! → http​://www.bunchmail.com/
Twitter/IRC​: @​xdg

[p5pRT]

From @xdg

0001-Restore-warning-for-l-on-filehandles.patch

From 4a300c01ecacf421b35116b56ed930f8a2a512ec Mon Sep 17 00:00:00 2001
From: David Golden <dagolden@cpan.org>
Date: Mon, 15 Apr 2013 11:44:04 +0100
Subject: [PATCH] Restore warning for -l on filehandles

Filehandles are no longer treated as names for -l. Instead, calling -l
on a filehandle returns undef to signal that it's an invalid operation.
If warnings are on, a warning is issued as well.

Other filetests let globs stringify via overloading, so this patch does
not prevent calling -l on an overloaded handle, though my implementation
for that is probably not the best.
---
 doio.c              |  8 ++++++++
 t/lib/warnings/doio |  7 ++++++-
 t/op/filetest.t     | 17 ++++++++++++-----
 3 files changed, 26 insertions(+), 6 deletions(-)

diff --git a/doio.c b/doio.c
index 4e8d48a..bca8838 100644
--- a/doio.c
+++ b/doio.c
@@ -1359,6 +1359,14 @@ Perl_my_lstat_flags(pTHX_ const U32 flags)
 
     PL_laststype = OP_LSTAT;
     PL_statgv = NULL;
+    /* XXX this should check for stringification overloading, not just
+     * any sort of magic */
+    if (SvROK(TOPs) && SvTYPE(SvRV(TOPs)) == SVt_PVIO && ! SvGAMAGIC(TOPs)) {
+	if ( ckWARN(WARN_IO) )
+            Perl_warner(aTHX_ packWARN(WARN_IO), "Use of -l on filehandle %s",
+		GvENAME((const GV *)SvRV(TOPs)));
+	return (PL_laststatval = -1);
+    }
     file = SvPV_flags_const_nolen(TOPs, flags);
     sv_setpv(PL_statname,file);
     PL_laststatval = PerlLIO_lstat(file,&PL_statcache);
diff --git a/t/lib/warnings/doio b/t/lib/warnings/doio
index 732f66d..f4a211a 100644
--- a/t/lib/warnings/doio
+++ b/t/lib/warnings/doio
@@ -157,12 +157,17 @@ Unsuccessful stat on filename containing newline at - line 3.
 Unsuccessful stat on filename containing newline at - line 4.
 ########
 # doio.c [Perl_my_stat]
+open $fh, $0 or die "# $!";
 use warnings 'io';
 -l STDIN;
+-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 STDIN at - line 4.
+Use of -l on filehandle $fh at - line 5.
 ########
 # doio.c [Perl_my_stat]
 use utf8;
diff --git a/t/op/filetest.t b/t/op/filetest.t
index 9ab049f..f7166a1 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 => 51 + 27*14);
 
 # Tests presume we are in t/op directory and that file 'TEST' is found
 # therein.
@@ -109,10 +109,17 @@ SKIP: {
  # Since we already have our skip block set up, we might as well put this
  # test here, too:
  # -l always treats a non-bareword argument as a file name
- system 'ln', '-s', $ro_empty_file, \*foo;
- local $^W = 1;
- is(-l \*foo, 1, '-l \*foo is a file name');
- unlink \*foo;
+ my $linkfile = tempfile();
+ system 'ln', '-s', $ro_empty_file, $linkfile;
+ open my $fh, '<', $linkfile or die "open $linkfile: $!";
+ is(-l $fh, undef, '-l HANDLE gives undef');
+ unlink $linkfile;
+
+ system 'ln', '-s', $ro_empty_file, "\\*foo";
+ system 'ls -l';
+ is(-l \*foo, undef, '-l \*foo gives undef');
+ is(-l "\\*foo", 1, '-l "\*foo" works');
+ unlink "\\*foo";
 }
 
 # test that _ is a bareword after filetest operators
-- 
1.8.2

[p5pRT]

@jkeenan - Status changed from 'new' to 'open'

[p5pRT]

From @cpansprout

On Mon Apr 15 18​:56​:31 2013, xdg@​xdg.me wrote​:

Here is a patch for blead Perl with tests, but part of it is a bit
crude. -l on filehandles should warn *unless* there is string
overloading on the handle. I wrote the patch with SvGAMAGIC, but it
really should be more specific to string overloading and I don't know
how to do that in XS/C.

So someone more wizardly than I should tweak this before it gets applied.

David

On Sun, Apr 14, 2013 at 2​:07 AM, David Golden <xdg@​xdg.me> wrote​:

On Sat, Apr 13, 2013 at 4​:14 PM, Brad Gilbert via RT
<perlbug-comment@​perl.org> wrote​:

Based on the commit message it may be related to

http​://perl5.git.perl.org/perl.git/commit/433644eed8ac93495dfaad947c1503

ce219b414b

Based on the commit message, that's pretty clearly the wrong fix​:

Historical behavior of C<-l $handle>​:

5\.6​: treat as filename

5\.8 to 5\.14​:
    \- without warnings​: treat as filename
    \- with warnings​: return undef and warn

5\.16​: treat as filename

The desired behavior would seem to be​:
- without warnings​: return undef
- with warnings​: return undef and warn

To me, it makes sense to keep the filename treatment. But if you really
want to warn, I have no problem with that.

I have two reasons for wanting to keep the filename treatment​:
1) Code that does ‘no warnings; -l $foo’ will continue to behave exactly
the same way as it has since 5.6.
2) We avoid the problem of having to detect string overloading, which
itself turns into a new source of unexpected behaviour.

Now, concerning your patch​:

From 4a300c01ecacf421b35116b56ed930f8a2a512ec Mon Sep 17 00​:00​:00 2001
From​: David Golden <dagolden@​cpan.org>
Date​: Mon, 15 Apr 2013 11​:44​:04 +0100
Subject​: [PATCH] Restore warning for -l on filehandles

Filehandles are no longer treated as names for -l. Instead, calling -l
on a filehandle returns undef to signal that it's an invalid operation.
If warnings are on, a warning is issued as well.

Other filetests let globs stringify via overloading, so this patch does
not prevent calling -l on an overloaded handle, though my implementation
for that is probably not the best.
---
doio.c | 8 ++++++++
t/lib/warnings/doio | 7 ++++++-
t/op/filetest.t | 17 ++++++++++++-----
3 files changed, 26 insertions(+), 6 deletions(-)

diff --git a/doio.c b/doio.c
index 4e8d48a..bca8838 100644
--- a/doio.c
+++ b/doio.c
@​@​ -1359,6 +1359,14 @​@​ Perl_my_lstat_flags(pTHX_ const U32 flags)

 PL\_laststype = OP\_LSTAT;
 PL\_statgv = NULL;

+ /* XXX this should check for stringification overloading, not just
+ * any sort of magic */

Furthermore, the use of the first G in SvGAMAGIC is unnecessary, as
get-magic will already have been called here (from memory; I didn’t
check). Also, it is wrong, because -l $foo and -l $tied should behave
the same way.

I don’t remember offhand how to check for specific overload types. But
searching for _amg_ (or _amt_?) in the source tree should find some
examples.

+ if (SvROK(TOPs) && SvTYPE(SvRV(TOPs)) == SVt_PVIO && !
SvGAMAGIC(TOPs)) {

Here you are checking that you have an ioref (*foo{IO}), so it doesn’t
apply to $fh as in open my $fh..., which is a globref. It also doesn’t
apply to -l *foo. What you need is something more like
if(isGV_with_GP(TOPs) || (SvROK(TOPs) && (SvTYPE(SvRV(TOPs)) == SVt_PVIO
|| isGV_with_GP(SvRV(TOPs))))).

(Maybe we should make a macro out of that.)

+ if ( ckWARN(WARN_IO) )
+ Perl_warner(aTHX_ packWARN(WARN_IO), "Use of -l on
filehandle %s",
+ GvENAME((const GV *)SvRV(TOPs)));

And GvENAME only applies to globs, so we would have to handle IO
thingies specially here (omit the " %s" part of the message), to avoid this​:

$ ./perl -Ilib -we '-l *STDOUT{IO}'
Segmentation fault​: 11

(with your patch).

+ return (PL_laststatval = -1);

As I noted above, I would prefer that we simply omit that statement, for
backward compatibility *and* simplicity of implementation (no need to
worry about SvAMAGIC).

I’m surprised I even got enough time to review your patch. I’m afraid I
have just run out of time, and I don’t know when I will have more.

(BTW, in case they are reading this, thank you to everyone who picked up
the loose ends when I ‘disappeared’.)

+ }
file = SvPV_flags_const_nolen(TOPs, flags);
sv_setpv(PL_statname,file);
PL_laststatval = PerlLIO_lstat(file,&PL_statcache);
diff --git a/t/lib/warnings/doio b/t/lib/warnings/doio
index 732f66d..f4a211a 100644
--- a/t/lib/warnings/doio
+++ b/t/lib/warnings/doio
@​@​ -157,12 +157,17 @​@​ Unsuccessful stat on filename containing newline
at - line 3.
Unsuccessful stat on filename containing newline at - line 4.
########
# doio.c [Perl_my_stat]
+open $fh, $0 or die "# $!";
use warnings 'io';
-l STDIN;
+-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 STDIN at - line 4.
+Use of -l on filehandle $fh at - line 5.
########
# doio.c [Perl_my_stat]
use utf8;
diff --git a/t/op/filetest.t b/t/op/filetest.t
index 9ab049f..f7166a1 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 => 51 + 27*14);

# Tests presume we are in t/op directory and that file 'TEST' is found
# therein.
@​@​ -109,10 +109,17 @​@​ SKIP​: {
# Since we already have our skip block set up, we might as well put this
# test here, too​:
# -l always treats a non-bareword argument as a file name
- system 'ln', '-s', $ro_empty_file, \*foo;
- local $^W = 1;
- is(-l \*foo, 1, '-l \*foo is a file name');
- unlink \*foo;
+ my $linkfile = tempfile();
+ system 'ln', '-s', $ro_empty_file, $linkfile;
+ open my $fh, '<', $linkfile or die "open $linkfile​: $!";
+ is(-l $fh, undef, '-l HANDLE gives undef');
+ unlink $linkfile;
+
+ system 'ln', '-s', $ro_empty_file, "\\*foo";
+ system 'ls -l';

I understand this patch is unfinished, but make sure the final version
does not emit ls’s output, as t/TEST doesn’t like that.

+ is(-l \*foo, undef, '-l \*foo gives undef');
+ is(-l "\\*foo", 1, '-l "\*foo" works');
+ unlink "\\*foo";

That last bit seems pointless. Surely you want to be testing "".\*foo, no?

}

# test that _ is a bareword after filetest operators
--
1.8.2

--

Father Chrysostomos

[p5pRT]

From @Hugmeir

On Sun, Apr 28, 2013 at 10​:07 PM, Father Chrysostomos via RT <
perlbug-followup@​perl.org> wrote​:

On Mon Apr 15 18​:56​:31 2013, xdg@​xdg.me wrote​:

Here is a patch for blead Perl with tests, but part of it is a bit
crude. -l on filehandles should warn *unless* there is string
overloading on the handle. I wrote the patch with SvGAMAGIC, but it
really should be more specific to string overloading and I don't know
how to do that in XS/C.

So someone more wizardly than I should tweak this before it gets applied.

David

On Sun, Apr 14, 2013 at 2​:07 AM, David Golden <xdg@​xdg.me> wrote​:

On Sat, Apr 13, 2013 at 4​:14 PM, Brad Gilbert via RT
<perlbug-comment@​perl.org> wrote​:

Based on the commit message it may be related to

http​://perl5.git.perl.org/perl.git/commit/433644eed8ac93495dfaad947c1503

ce219b414b

Based on the commit message, that's pretty clearly the wrong fix​:

Historical behavior of C<-l $handle>​:

5\.6​: treat as filename

5\.8 to 5\.14​:
    \- without warnings​: treat as filename
    \- with warnings​: return undef and warn

5\.16​: treat as filename

The desired behavior would seem to be​:
- without warnings​: return undef
- with warnings​: return undef and warn

To me, it makes sense to keep the filename treatment. But if you really
want to warn, I have no problem with that.

I have two reasons for wanting to keep the filename treatment​:
1) Code that does ‘no warnings; -l $foo’ will continue to behave exactly
the same way as it has since 5.6.
2) We avoid the problem of having to detect string overloading, which
itself turns into a new source of unexpected behaviour.

Now, concerning your patch​:

From 4a300c01ecacf421b35116b56ed930f8a2a512ec Mon Sep 17 00​:00​:00 2001
From​: David Golden <dagolden@​cpan.org>
Date​: Mon, 15 Apr 2013 11​:44​:04 +0100
Subject​: [PATCH] Restore warning for -l on filehandles

Filehandles are no longer treated as names for -l. Instead, calling -l
on a filehandle returns undef to signal that it's an invalid operation.
If warnings are on, a warning is issued as well.

Other filetests let globs stringify via overloading, so this patch does
not prevent calling -l on an overloaded handle, though my implementation
for that is probably not the best.
---
doio.c | 8 ++++++++
t/lib/warnings/doio | 7 ++++++-
t/op/filetest.t | 17 ++++++++++++-----
3 files changed, 26 insertions(+), 6 deletions(-)

diff --git a/doio.c b/doio.c
index 4e8d48a..bca8838 100644
--- a/doio.c
+++ b/doio.c
@​@​ -1359,6 +1359,14 @​@​ Perl_my_lstat_flags(pTHX_ const U32 flags)

 PL\_laststype = OP\_LSTAT;
 PL\_statgv = NULL;

+ /* XXX this should check for stringification overloading, not just
+ * any sort of magic */

Furthermore, the use of the first G in SvGAMAGIC is unnecessary, as
get-magic will already have been called here (from memory; I didn’t
check). Also, it is wrong, because -l $foo and -l $tied should behave
the same way.

I don’t remember offhand how to check for specific overload types. But
searching for _amg_ (or _amt_?) in the source tree should find some
examples.

+ if (SvROK(TOPs) && SvTYPE(SvRV(TOPs)) == SVt_PVIO && !
SvGAMAGIC(TOPs)) {

Here you are checking that you have an ioref (*foo{IO}), so it doesn’t
apply to $fh as in open my $fh..., which is a globref. It also doesn’t
apply to -l *foo. What you need is something more like
if(isGV_with_GP(TOPs) || (SvROK(TOPs) && (SvTYPE(SvRV(TOPs)) == SVt_PVIO
|| isGV_with_GP(SvRV(TOPs))))).

(Maybe we should make a macro out of that.)

+ if ( ckWARN(WARN_IO) )
+ Perl_warner(aTHX_ packWARN(WARN_IO), "Use of -l on
filehandle %s",
+ GvENAME((const GV *)SvRV(TOPs)));

And GvENAME only applies to globs, so we would have to handle IO
thingies specially here (omit the " %s" part of the message), to avoid
this​:

$ ./perl -Ilib -we '-l *STDOUT{IO}'
Segmentation fault​: 11

(with your patch).

As a minor addendum, that's not UTF8-clean either.

[p5pRT]

From @rjbs

FC's reasons for treating things as a string seem reasonable to me. I have just pushed 934fd9a
as smoke-me/rjbs/handle-l-test, restoring the warning and leaving the handle treated like a
string.

It would probably be a good idea for someone to review this patch! It involves me looking at
stuff on the stack, which seems like a recipe for trouble. ;)

All tests successful, including tests restored and added.

--
rjbs

[p5pRT]

From @cpansprout

On Tue May 07 16​:05​:48 2013, rjbs wrote​:

FC's reasons for treating things as a string seem reasonable to me. I
have just pushed 934fd9a
as smoke-me/rjbs/handle-l-test, restoring the warning and leaving the
handle treated like a
string.

It would probably be a good idea for someone to review this patch! It
involves me looking at
stuff on the stack, which seems like a recipe for trouble. ;)

Two things​:

1) The error is not utf8-clean. %s" should be %"HEKf and GvENAME should
be GvENAME_HEK.

2) The warning is only produced for globrefs, not globs or iorefs. Now,
this is exactly what 5.8-5.14 did (i.e., warning inconsistently), so
it’s not so bad. It could be considered a partial fix. I leave it to
you whether to change that now.

--

Father Chrysostomos

[p5pRT]

From @rjbs

Marked non-blocking, and will look at further improvement after the thaw.

--
rjbs

[p5pRT]

From @cpansprout

On Thu May 09 09​:37​:28 2013, sprout wrote​:

On Tue May 07 16​:05​:48 2013, rjbs wrote​:

FC's reasons for treating things as a string seem reasonable to me. I
have just pushed 934fd9a
as smoke-me/rjbs/handle-l-test, restoring the warning and leaving the
handle treated like a
string.

It would probably be a good idea for someone to review this patch! It
involves me looking at
stuff on the stack, which seems like a recipe for trouble. ;)

Two things​:

1) The error is not utf8-clean. %s" should be %"HEKf and GvENAME should
be GvENAME_HEK.

2) The warning is only produced for globrefs, not globs or iorefs. Now,
this is exactly what 5.8-5.14 did (i.e., warning inconsistently), so
it’s not so bad. It could be considered a partial fix. I leave it to
you whether to change that now.

I’ve addressed these remaining issues in commit 5840701.

--

Father Chrysostomos

[p5pRT]

@cpansprout - Status changed from 'open' to 'resolved'

[p5pRT]

From @rjbs

* Father Chrysostomos via RT <perlbug-followup@​perl.org> [2013-06-04T23​:17​:04]

I’ve addressed these remaining issues in commit 5840701.

Thanks. Better for you to have done it than me!

--
rjbs