File handle doesn't close when out of scope due to \shift

[p5pRT]

Migrated from rt.perl.org#126676 (status was 'open')

Searchable as RT126676$

[p5pRT]

From @toddr

Created by @toddr

While preparing to move to 5.22\, we noticed a bug which manifests due to our use of \shift. While \shift seems to be a special kind of evil\, Perl does support it so I'd call this a bug for the time being. In the below example\, Perl never decreases the refcount of $fh when it is passed to another subroutine and the passed variable (not a copy of it) is directly used.

This bisects to 7bdb4ff0943cf93297712faf504cdd425426e57f introduced in 5.21.4

If you use $_[0] directly in the subroutine instead of assging $rv to \shift and then accessing $$rv\, then the reference count is 1 after nested2 returns. Also there's a comment in the code below that if you do a print `ls -ld $file`\, then the file has the right file size. Though I'm unsure if it's because something fixes the refcount as a result of the `` action or that some IO buffer ends up getting flushed as a result of the action. I guess we could set a DESTROY on $fh if we wanted to debug that further.

NOTE​: The use of \shift is also currently breaking Devel​::Cover very badly even in 5.14​: https://github.com/pjcj/Devel--Cover/issues/125 I have not investigated if the 5.21.4 change actually fixes the bug in B/Devel​::Cover or if there is also another B bug related to this.

Example code also used to bisect​:

===== foo.pl #!perl

use B qw/svref_2object/;

my $file = "/tmp/file";

sub nested2 {   my ( $rv ) = ( \shift );   open( $$rv\, ">"\, $file) or die; }

sub nested1 {   my $fh;   nested2($fh);   print {$fh} "contents";

  # The ref count on $fh should be 1 now..?   my $obj = svref_2object($fh);   my $count = $obj->REFCNT();   return $count; }

unlink $file; my $refcount = nested1();

$refcount == 1 or die("Ref count should have been 1 after returning from nested2 but it's $refcount instead?");

# If you uncomment this line and comment the above die\, -z is false in perl 5.22 as desired. #print `ls -l $file`; -z $file and die("File has not been closed yet!");

Perl Info

``` Flags: category=core severity=medium Site configuration information for perl 5.22.1: Configured by Todd at Fri Nov 13 01:11:55 CST 2015. Summary of my perl5 (revision 5 version 22 subversion 1) configuration: Platform: osname=linux, osvers=2.6.32-431.29.2.el6.i686, archname=i386-linux-64int uname='linux rpmb-32-centos-65 2.6.32-431.29.2.el6.i686 #1 smp tue sep 9 20:14:52 utc 2014 i686 i686 i386 gnulinux ' config_args='-des -Dusedevel -Darchname=i386-linux-64int -Dcc=/usr/bin/gcc -Dcpp=/usr/bin/cpp -DDEBUGGING=-g -Duselargefiles=yes -Duseposix=true -Dhint=recommended -Duseperlio=yes -Dccflags=-I/usr/local/perl/522/include -L/usr/local/perl/522/lib -I/usr/local/include -L/usr/local/lib -Dcppflags=-I/usr/local/perl/522/include -L/usr/local/perl/522/lib -I/usr/local/include -L/usr/local/lib -Dldflags=-Wl,-rpath -Wl,/usr/local/perl/522/lib -L/usr/local/perl/522/lib -L/usr/local/lib -Dprefix=/usr/local/perl/522 -Dsiteprefix=/opt/perl5/522 -Dsitebin=/opt/perl5/522/bin -Dsitelib=/opt/perl5/522/site_lib -Dusevendorprefix=true -Dvendorbin=/usr/local/perl/522/bin -Dvendorprefix=/usr/local/perl/522/lib/perl5 -Dvendorlib=/usr/local/perl/522/lib/perl5/vendor_lib -Dprivlib=/usr/local/perl/522/lib/perl5/5.22.1 -Dman1dir=none -Dman3dir=none -Dscriptdir=/usr/local/perl/522/bin -Dscriptdirexp=/usr/local/perl/522/bin -Dsiteman1dir=none -Dsiteman3dir=none -Dinstallman1dir=none -Dversiononly=no -Dinstallusrbinperl=no -Dcf_by=Todd -Dmyhostname=localhost -Dperladmin=root@localhost -Di_dbm=/usr/local/include -Di_gdbm=/usr/local/include -Di_ndbm=/usr/local/include -Ud_dosuid -Uuserelocatableinc -Umad -Uusethreads -Uusemultiplicity -Uusesocks -Uuselongdouble -Ui_db -Aldflags=-L/usr/local/perl/522/lib -L/usr/local/lib -L/usr/lib -L/lib -lgdbm -Dlocincpth=/usr/local/perl/522/include /usr/local/include /usr/local/include -Duse64bitint -Uuse64bitall -Acflags=-fPIC -DPIC -m32 -I/usr/local/perl/522/include -I/usr/local/include -Dlibpth=/usr/local/perl/522/lib /usr/local/lib /usr/local/lib /lib /usr/lib ' hint=recommended, useposix=true, d_sigaction=define useithreads=undef, usemultiplicity=undef use64bitint=define, use64bitall=undef, uselongdouble=undef usemymalloc=n, bincompat5005=undef Compiler: cc='/usr/bin/gcc', ccflags ='-I/usr/local/perl/522/include -L/usr/local/perl/522/lib -I/usr/local/include -L/usr/local/lib -fwrapv -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -D_FORTIFY_SOURCE=2', optimize='-O2 -g', cppflags='-I/usr/local/perl/522/include -L/usr/local/perl/522/lib -I/usr/local/include -L/usr/local/lib -I/usr/local/perl/522/include -L/usr/local/perl/522/lib -I/usr/local/include -L/usr/local/lib -fwrapv -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include' ccversion='', gccversion='4.4.7 20120313 (Red Hat 4.4.7-4)', gccosandvers='' intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=12345678, doublekind=3 d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12, longdblkind=3 ivtype='long long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8 alignbytes=4, prototype=define Linker and Libraries: ld='/usr/bin/gcc', ldflags ='-Wl,-rpath -Wl,/usr/local/perl/522/lib -L/usr/local/perl/522/lib -L/usr/local/lib -L/usr/local/perl/522/lib -L/usr/local/lib -L/usr/lib -L/lib -lgdbm -fstack-protector -L/usr/local/lib' libpth=/usr/local/perl/522/lib /usr/local/lib /usr/local/lib /lib /usr/lib /usr/local/lib /usr/lib libs=-lpthread -lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc perllibs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc libc=libc-2.12.so, so=so, useshrplib=false, libperl=libperl.a gnulibc_version='2.12' Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E' cccdlflags='-fPIC', lddlflags='-shared -O2 -g -L/usr/local/perl/522/lib -L/usr/local/lib -L/usr/lib -L/lib -L/usr/local/lib -fstack-protector' Locally applied patches: RC1 @INC for perl 5.22.1: /usr/local/perl/522/lib/perl5/vendor_lib/i386-linux-64int /usr/local/perl/522/lib/perl5/vendor_lib /usr/local/perl/522/lib/perl5/5.22.1/i386-linux-64int /usr/local/perl/522/lib/perl5/5.22.1 /opt/perl5/522/site_lib/i386-linux-64int /opt/perl5/522/site_lib . Environment for perl 5.22.1: HOME=/root LANG=en_US.UTF-8 LANGUAGE (unset) LD_LIBRARY_PATH (unset) LOGDIR (unset) PATH=/usr/local/perl/522/bin:/usr/local/bin:/usr/bin:/bin:/usr/sbin:/sbin: PERL_BADLANG (unset) SHELL=/bin/zsh ```

[p5pRT]

From @ap

* Todd Rinaldo \perlbug\-followup@​perl\.org [2015-11-18 19​:45]​:

# If you uncomment this line and comment the above die\, -z is false in perl 5.22 as desired. #print `ls -l $file`; -z $file and die("File has not been closed yet!");

$ perldoc -f system | perl -00ne 'print if /flush/'   Beginning with v5.6.0\, Perl will attempt to flush all files opened   for output before any operation that may do a fork\, but this may not   be supported on some platforms (see perlport). To be safe\, you may   need to set $| ($AUTOFLUSH in English) or call the "autoflush()"   method of "IO​::Handle" on any open handles.

[p5pRT]

The RT System itself - Status changed from 'new' to 'open'

[p5pRT]

From @toddr

On Wed Nov 18 17​:02​:21 2015\, aristotle wrote​:

$ perldoc -f system | perl -00ne 'print if /flush/' Beginning with v5.6.0\, Perl will attempt to flush all files opened for output before any operation that may do a fork\, but this may not be supported on some platforms (see perlport). To be safe\, you may need to set $| ($AUTOFLUSH in English) or call the "autoflush()" method of "IO​::Handle" on any open handles.

Thanks! That totally explains the flush. This probably means the file handle is not freed until global destruction.

[p5pRT]

From @iabyn

On Wed\, Nov 18\, 2015 at 10​:39​:46AM -0800\, Todd Rinaldo wrote​:

While preparing to move to 5.22\, we noticed a bug which manifests due to our use of \shift. While \shift seems to be a special kind of evil\, Perl does support it so I'd call this a bug for the time being. In the below example\, Perl never decreases the refcount of $fh when it is passed to another subroutine and the passed variable (not a copy of it) is directly used.

This bisects to 7bdb4ff0943cf93297712faf504cdd425426e57f introduced in 5.21.4

If you use $_[0] directly in the subroutine instead of assging $rv to \shift and then accessing $$rv\, then the reference count is 1 after nested2 returns.

Its not so much an issue with \shift as an issue with anything (such as open()) that attempts to instantiate an anonymous value into a ref to a typeglob; e.g.​:

  use Devel​::Peek;

  my $fh;   my $ref_fh = \$fh;   open( $$ref_fh\, "\<"\, "/dev/null") or die;   Dump $fh;

  my $fh2;   open( $fh2\, "\<"\, "/dev/null") or die;   Dump $fh2;

which gives

  ...   SV = PVGV(0x28a88f8) at 0x286d120   REFCNT = 2   NAME = "_GEN_0"

  ...   SV = PVGV(0x28a8928) at 0x288cf28   REFCNT = 1   NAME = "$fh2"

Note that the first one has an extra ref count\, which is added by the commit you bisected. In fact\, that extra ref count is technically correct\, but does cause the freeing of the file handle to be delayed.

The real issue is how the new typeglob is created\, and whether it's added to the stash or not.

When it's known at compile time what the name the variable that will be instantiated is\, then the typeglob is created with a name that is descriptive of who "owns" it\, e.g. the 'NAME = "$fh2"' above. Sometimes these names can be a bit vague​: for example\, 'open $a[0]\, ...' gives 'NAME = "$a[...]"'\, while 'open $a[0][0]\, ...' gives 'NAME = "__ANONIO__"'.

The two important thing about all those names is that they are determined at compile time (and stored as the targ for the rv2gv op)\, and that the GV is *not* added to the stash. So it only needs a refcount of 1\, and doesn't get delayed in freeing.

On the other hand\, if a name isn't determined at compile time\, as is the case with $$ref\, then the rv2gv's targ is zero\, and it instead creates a a new anonymous typeglob\, with a name of the form _GEN_NNN\, which *is* added to the current stash (and so needs the extra ref).

I think the easiest fix for this is to\, for the latter case\, treat it like the former case\, using a name of '__ANONIO__' (and not add it to any stash).

This is an area I'm not too familiar with\, so I don't know whether there are any drawbacks to this idea.

NOTE​: The use of \shift is also currently breaking Devel​::Cover very badly even in 5.14​: https://github.com/pjcj/Devel--Cover/issues/125 I have not investigated if the 5.21.4 change actually fixes the bug in B/Devel​::Cover or if there is also another B bug related to this.

Well I just tried it on 5.44.4\, 5.20.0 and 5.22.0; I saw problems with the first two consistent with an SV being reused while still owned\, but not with 5.22.0. So it looks like that was fixed with FC's commit.

-- Technology is dominated by two types of people​: those who understand what they do not manage\, and those who manage what they do not understand.

[p5pRT]

From @cpansprout

On Nov 19\, 2015\, at 6​:15 AM\, Dave Mitchell \davem@&#8203;iabyn\.com wrote​:

On the other hand\, if a name isn't determined at compile time\, as is the case with $$ref\, then the rv2gv's targ is zero\, and it instead creates a a new anonymous typeglob\, with a name of the form _GEN_NNN\, which *is* added to the current stash (and so needs the extra ref).

I think the easiest fix for this is to\, for the latter case\, treat it like the former case\, using a name of '__ANONIO__' (and not add it to any stash).

It has been on my ever-growing to-do list for some time to consider whether _GEN_NNN should every be added to the stash. Every time that happens\, it’s a leak. Does anybody ever access them by name?

Whether this should be fixed by (a) switching everything to __ANONIO__ or by (b) using _GEN_NNN without adding it to the stash I cannot say. I don’t understand why we ended up with an inconsistency in the first place. (Digging in history to find out which one came first might shed some light on it.) Using _GEN_* does allow different handles to be distinguished in error messages\, but __ANONIO__ certainly seems cleaner. For backward-compatibility\, though\, maybe option b is the best choice.

This is an area I'm not too familiar with\, so I don't know whether there are any drawbacks to this idea.

NOTE​: The use of \shift is also currently breaking Devel​::Cover very badly even in 5.14​: https://github.com/pjcj/Devel--Cover/issues/125 I have not investigated if the 5.21.4 change actually fixes the bug in B/Devel​::Cover or if there is also another B bug related to this.

Well I just tried it on 5.44.4\,

Wow!

[p5pRT]

From @toddr

On Thu\, 19 Nov 2015 09​:20​:06 -0800\, sprout wrote​:

It has been on my ever-growing to-do list for some time to consider whether _GEN_NNN should every be added to the stash. Every time that happens\, it’s a leak. Does anybody ever access them by name?

Whether this should be fixed by (a) switching everything to __ANONIO__ or by (b) using _GEN_NNN without adding it to the stash I cannot say. I don’t understand why we ended up with an inconsistency in the first place. (Digging in history to find out which one came first might shed some light on it.) Using _GEN_* does allow different handles to be distinguished in error messages\, but __ANONIO__ certainly seems cleaner. For backward-compatibility\, though\, maybe option b is the best choice.

FYI\,

We're in the process of submitting a change to Perl​::Critic to discourage the use of \shift. https://github.com/Perl-Critic/Perl-Critic/pull/837

At this point we've now got 4 major versions of perl with this issue.

[toddr]

FYI Perl::Critic now warns people not to do this in code because of this leak.