view release on metacpan or  search on metacpan

t/70callbacks.t  view on Meta::CPAN

$stress_sth->execute(@params);

{
    package LeakDetect;

    our $count = 0;

    sub new {
        my $class = shift;
        $count++;
        return bless {}, $class;
    }

    sub DESTROY {
        $count--;
    }
}

# ensure running a callback does not leak extant $_
$dbh = DBI->connect('DBI:NullP:test');
$dbh->{Callbacks}{ping} = sub {};

# with plain assignment to $_
$_ = LeakDetect->new;
if ($] >= 5.008002) {
    is $LeakDetect::count, 1, "[plain] live object count is 1 after new()";
    my $obj = $_;
    $dbh->ping;
    is $_, $obj, '[plain] $_ still holds an object reference after the callback';
}
$_ = undef;
is $_, undef, '[plain] $_ is undef at the end';
is $LeakDetect::count, 0, "[plain] live object count is 0 after all object references are gone";

# with localized $_
if ($] >= 5.008002) {
    local $_ = LeakDetect->new;
    is $LeakDetect::count, 1, "[local] live object count is 1 after new()";
    my $obj = $_;
    $dbh->ping;
    is $_, $obj, '[local] $_ still holds an object reference after the callback';
}
is $_, undef, '[local] $_ is undef at the end';
is $LeakDetect::count, 0, "[local] live object count is 0 after all object references are gone";

# with implicit localization of $_
for (LeakDetect->new) {
    is $LeakDetect::count, 1, "[foreach] live object count is 1 after new()";
    my $obj = $_;
    $] >= 5.008002 or next;
    $dbh->ping;
    is $_, $obj, '[foreach] $_ still holds an object reference after the callback';
}
is $_, undef, '[foreach] $_ is undef at the end';
is $LeakDetect::count, 0, "[foreach] live object count is 0 after all object references are gone";

done_testing();

__END__

A generic 'transparent' callback looks like this:
(this assumes only scalar context will be used)

    sub {
        my $h = shift;
        return if our $avoid_deep_recursion->{"$h $_"}++;
        my $this = $h->$_(@_);
        undef $_;    # tell DBI not to call original method
        return $this; # tell DBI to return this instead
    };

XXX should add a test for this
XXX even better would be to run chunks of the test suite with that as a '*' callback. In theory everything should pass (except this test file, naturally)..