1#!perl
2
3# Based on the test case created by Kevin Ryde for #42502
4
5# All MyObject instances are held in @INSTANCES, only removed by an explicit
6# destroy().  This is like Gtk2::Window from perl-gtk2 where top-level
7# windows are held by gtk in the "list_toplevels" and stay alive until
8# explicitly destroyed.
9
10package MyObject;
11
12use strict;
13use warnings;
14our @INSTANCES;
15
16sub new {
17    my ($class) = @_;
18    my $self = bless { data => ['this is a myobject'] }, $class;
19    push @INSTANCES, $self;
20    return $self;
21}
22
23sub destroy {
24    my ($self) = @_;
25    return ( @INSTANCES = grep { $_ != $self } @INSTANCES );
26}
27
28package main;
29
30use strict;
31use warnings;
32use Test::Weaken;
33use Test::More tests => 2;
34
35use lib 't/lib';
36use Test::Weaken::Test;
37
38@INSTANCES = ();
39my $test = Test::Weaken::leaks(
40    sub { MyObject->new },
41    sub {
42        my ($obj) = @_;
43        $obj->destroy;
44    }
45);
46Test::More::ok( ( !$test ), 'good destructor' );
47
48@INSTANCES = ();
49$test = Test::Weaken::leaks( sub { return MyObject->new }, sub { } );
50my $unfreed_count = $test ? $test->unfreed_count() : 0;
51Test::Weaken::Test::is( $unfreed_count, 4, 'no-op destructor' );
52