Object instantiated/assigned inside of do { } block does not have DESTROY method called if assignment is the only action in the block

[p5pRT]

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

Searchable as RT133489$

[p5pRT]

From @cpanelrikus

If you have a do block in which the only action is declaring a lexical variable and assigning it an instantiated object, the DESTROY method for that object is not called when the variable goes out of scope at the end of the block:

(Note: The sleep is optional and just for reassurance that there's not some small race condition, and the kill is to ensure that no additional destruction happens, which would hide the problem.)

[a@remote]~% ~/perl5/perlbrew/build/perl-5.28.0/perl-5.28.0/perl -e 'do
{ my $obj = Obj->new(); }; sleep 2; kill "KILL", $$; package Obj; sub
new { return bless {}, __PACKAGE__; } DESTROY { print "destroy called\n" }'
zsh: killed    ~/perl5/perlbrew/build/perl-5.28.0/perl-5.28.0/perl -e
[a@remote]~%

However, putting anything at the beginning or the end of the block will change this behavior:

[a@remote]~% ~/perl5/perlbrew/build/perl-5.28.0/perl-5.28.0/perl -e 'do
{ 1; my $obj = Obj->new(); }; sleep 2; kill "KILL", $$; package Obj; sub
new { return bless {}, __PACKAGE__; } DESTROY { print "destroy called\n" }'
destroy called
zsh: killed    ~/perl5/perlbrew/build/perl-5.28.0/perl-5.28.0/perl -e
[a@remote]~% ~/perl5/perlbrew/build/perl-5.28.0/perl-5.28.0/perl -e 'do
{ my $obj = Obj->new(); 1; }; sleep 2; kill "KILL", $$; package Obj; sub
new { return bless {}, __PACKAGE__; } DESTROY { print "destroy called\n" }'
destroy called
zsh: killed    ~/perl5/perlbrew/build/perl-5.28.0/perl-5.28.0/perl -e
[a@remote]~%

This type of "loop" block is unaffected:

[a@remote]~% ~/perl5/perlbrew/build/perl-5.28.0/perl-5.28.0/perl -e '{
my $obj = Obj->new(); }; sleep 2; kill "KILL", $$; package Obj; sub new
{ return bless {}, __PACKAGE__; } DESTROY { print "destroy called\n" }'
destroy called
zsh: killed    ~/perl5/perlbrew/build/perl-5.28.0/perl-5.28.0/perl -e
[a@remote]~%

The impact of this seems minimal, and I'm not completely sure this is a bug at all, but without more knowledge of how do { } works, it's unexpected, at least. The inconsistent behavior depending on whether the assignment is the only thing in the block or not is also strange.

Replicated on:

blead:
  This is perl 5, version 29, subversion 3 (v5.29.3
(v5.29.2-39-g1284d2c34d)) built for x86_64-linux
  (with 1 registered patch, see perl -V for more detail)

stable:
  This is perl 5, version 28, subversion 0 (v5.28.0) built for x86_64-linux
  (with 1 registered patch, see perl -V for more detail)

cPanel perl:
  This is perl 5, version 26, subversion 0 (v5.26.0) built for
x86_64-linux-64int
  (with 47 registered patches, see perl -V for more detail)

Mac OS X perl:
  This is perl 5, version 18, subversion 2 (v5.18.2) built for
darwin-thread-multi-2level
  (with 2 registered patches, see perl -V for more detail)

CentOS 7 perl:
  This is perl 5, version 16, subversion 3 (v5.16.3) built for
x86_64-linux-thread-multi
  (with 33 registered patches, see perl -V for more detail)

Perl Info

Flags:
     category=core
     severity=low

Site configuration information for perl 5.28.0:

Configured by root at Fri Aug 31 09:45:50 CDT 2018.

Summary of my perl5 (revision 5 version 28 subversion 0) configuration:

   Platform:
     osname=linux
     osvers=3.10.0-862.11.6.el7.x86_64
     archname=x86_64-linux
     uname='linux remote.remote.remote 3.10.0-862.11.6.el7.x86_64 #1 smp 
tue aug 14 21:49:04 utc 2018 x86_64 x86_64 x86_64 gnulinux '
     config_args='-de -Dprefix=/home/a/perl5/perlbrew/perls/perl-5.28.0 
-Aeval:scriptdir=/home/a/perl5/perlbrew/perls/perl-5.28.0/bin'
     hint=recommended
     useposix=true
     d_sigaction=define
     useithreads=undef
     usemultiplicity=undef
     use64bitint=define
     use64bitall=define
     uselongdouble=undef
     usemymalloc=n
     default_inc_excludes_dot=define
     bincompat5005=undef
   Compiler:
     cc='cc'
     ccflags ='-fwrapv -fno-strict-aliasing -pipe 
-fstack-protector-strong -I/usr/local/include -D_LARGEFILE_SOURCE 
-D_FILE_OFFSET_BITS=64 -D_FORTIFY_SOURCE=2'
     optimize='-O2'
     cppflags='-fwrapv -fno-strict-aliasing -pipe 
-fstack-protector-strong -I/usr/local/include'
     ccversion=''
     gccversion='4.8.5 20150623 (Red Hat 4.8.5-28)'
     gccosandvers=''
     intsize=4
     longsize=8
     ptrsize=8
     doublesize=8
     byteorder=12345678
     doublekind=3
     d_longlong=define
     longlongsize=8
     d_longdbl=define
     longdblsize=16
     longdblkind=3
     ivtype='long'
     ivsize=8
     nvtype='double'
     nvsize=8
     Off_t='off_t'
     lseeksize=8
     alignbytes=8
     prototype=define
   Linker and Libraries:
     ld='cc'
     ldflags =' -fstack-protector-strong -L/usr/local/lib'
     libpth=/usr/local/lib /usr/lib /lib/../lib64 /usr/lib/../lib64 /lib 
/lib64 /usr/lib64 /usr/local/lib64
     libs=-lpthread -lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc 
-lgdbm_compat
     perllibs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc
     libc=libc-2.17.so
     so=so
     useshrplib=false
     libperl=libperl.a
     gnulibc_version='2.17'
   Dynamic Linking:
     dlsrc=dl_dlopen.xs
     dlext=so
     d_dlsymun=undef
     ccdlflags='-Wl,-E'
     cccdlflags='-fPIC'
     lddlflags='-shared -O2 -L/usr/local/lib -fstack-protector-strong'

Locally applied patches:
     Devel::PatchPerl 1.52


@INC for perl 5.28.0:
/home/a/perl5/perlbrew/perls/perl-5.28.0/lib/site_perl/5.28.0/x86_64-linux
     /home/a/perl5/perlbrew/perls/perl-5.28.0/lib/site_perl/5.28.0
/home/a/perl5/perlbrew/perls/perl-5.28.0/lib/5.28.0/x86_64-linux
     /home/a/perl5/perlbrew/perls/perl-5.28.0/lib/5.28.0


Environment for perl 5.28.0:
     HOME=/home/a
     LANG=en_US.UTF-8
     LANGUAGE (unset)
     LD_LIBRARY_PATH (unset)
     LOGDIR (unset)
PATH=/usr/local/cpanel/3rdparty/lib/path-bin:/usr/local/bin:/bin:/usr/bin:/home/a/bin:/usr/local/sbin:/usr/sbin:/opt/cpanel/composer/bin
     PERL_BADLANG (unset)
     SHELL=/bin/zsh

[p5pRT]

From @jkeenan

Behavior confirmed on perl-5.28.0. For the benefit of others who wish to confirm, I'm attaching the 4 variants.

Thank you very much.

-- James E Keenan (jkeenan@​cpan.org)

[p5pRT]

From @jkeenan

Simply inserting a 1; makes this work as expected.

#!/usr/bin/env perl
use strict;
use warnings;

do { 1; my $obj = Obj->new(); };
sleep 2;
kill "KILL", $$;

package Obj;
sub new { return bless {}, __PACKAGE__; }
DESTROY { print "destroy called\n" }

[p5pRT]

From @jkeenan

with a second line, do{} works as expected.

#!/usr/bin/env perl
use strict;
use warnings;

do { my $obj = Obj->new(); 1; };
sleep 2;
kill "KILL", $$;

package Obj;
sub new { return bless {}, __PACKAGE__; }
DESTROY { print "destroy called\n" }

[p5pRT]

From @jkeenan

Without do this works as expected.

#!/usr/bin/env perl
use strict;
use warnings;

{ my $obj = Obj->new(); };
sleep 2;
kill "KILL", $$;

package Obj;
sub new { return bless {}, __PACKAGE__; }
DESTROY { print "destroy called\n" }

[p5pRT]

From @jkeenan

This code never displays "destroy called"

#!/usr/bin/env perl
use strict;
use warnings;

do { my $obj = Obj->new(); };
sleep 2;
kill "KILL", $$;

package Obj;
sub new { return bless {}, __PACKAGE__; }
DESTROY { print "destroy called\n" }

[p5pRT]

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

[toddr]

perl-all seems to indicate this has been broken back to at least 5.6.0

[rawleyfowler]

There is no OP_LEAVE call, unless there is a second param in do.

With

perl -MO=Concise,-exec -e 'do
{1; my $obj = Obj->new();}; sleep 2; kill "KILL", $$; package Obj; sub
new { return bless {}, __PACKAGE__; }; DESTROY { print "destroy called\n" }'

1  <0> enter v
2  <;> nextstate(main 1 -e:2) v:{
3  <0> enter v
4  <;> nextstate(main 2 -e:2) v
5  <0> pushmark s
6  <$> const(PV "Obj") sM/BARE
7  <.> method_named(PV "new") s
8  <1> entersub[t2] sKRS/TARG
9  <1> padsv_store[$obj:2,3] vKS/LVINTRO
a  <@> leave vKP
b  <;> nextstate(main 4 -e:2) v:{
c  <$> const(IV 2) s
d  <1> sleep[t3] vK/1
e  <;> nextstate(main 4 -e:2) v:{
f  <0> pushmark s
g  <$> const(PV "KILL") s
h  <$> gvsv(*$) s
i  <@> kill[t4] vK/1
j  <@> leave[1 ref] vKP/REFC

With

perl -MO=Concise,-exec -e 'do
{my $obj = Obj->new();}; sleep 2; kill "KILL", $$; package Obj; sub
new { return bless {}, __PACKAGE__; }; DESTROY { print "destroy called\n" }'

1  <0> enter v
2  <;> nextstate(main 1 -e:2) v:{
3  <0> pushmark s
4  <$> const(PV "Obj") sM/BARE
5  <.> method_named(PV "new") s
6  <1> entersub[t2] sKRS/TARG
7  <1> padsv_store[$obj:2,3] vKS/LVINTRO
8  <;> nextstate(main 4 -e:2) v:{
9  <$> const(IV 2) s
a  <1> sleep[t3] vK/1
b  <;> nextstate(main 4 -e:2) v:{
c  <0> pushmark s
d  <$> const(PV "KILL") s
e  <$> gvsv(*$) s
f  <@> kill[t4] vK/1
g  <@> leave[1 ref] vKP/REFC

[rawleyfowler]

do_kids:
                /* Apply void context to all kids except the last, which
                 * is scalar (ignoring a trailing ex-nextstate in determining
                 * if it's the last kid). E.g.
                 *      $scalar = do { void; void; scalar }
                 * Except that 'when's are always scalar, e.g.
                 *      $scalar = do { given(..) {
                    *                 when (..) { scalar }
                    *                 when (..) { scalar }
                    *                 ...
                    *                }}
                    */

I'm guessing this is the issue, I'll try to fix this.