[perl #117595] Perl 5.16 regression: lost warning for -l on filehandle

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


---
via perlbug:  queue: perl5 status: open
https://rt.perl.org:443/rt3/Ticket/Display.html?id=117595

• [perl #117595] Perl 5.16 regression: lost warning for -l on filehandle by Father Chrysostomos via RT
• Re: [perl #117595] Perl 5.16 regression: lost warning for -l on filehandle by Brian Fraser