view release on metacpan or  search on metacpan

xt/89_leak.t  view on Meta::CPAN

        reconnect => 1, reconnect_delay => 50);
    $g->register_function('xt_leak_wkr_'.$$ => sub { 'r' });
    $g->register_function('xt_leak_wkr2_'.$$ => sub { 'r' });
    $g->on_connect(sub { EV::break });
    my $w = EV::timer 3, 0, sub { EV::break };
    EV::run;

    # Bounce the connection
    $g->disconnect;
    $g->connect($host, $port);
    $w = EV::timer 1, 0, sub { EV::break };
    EV::run;

    $g->reset_abilities;
    undef $g;
    pass 'register+reconnect cycle';
}

# 4. Async jobs that never complete (DESTROY drops their refs)
{
    my $cli = EV::Gearman->new(host => $host, port => $port);
    my $wkr = EV::Gearman->new(host => $host, port => $port);
    my @stash;  # holds job refs forever in normal use
    $wkr->register_function('xt_leak_async_'.$$ => { async => 1 }, sub {
        push @stash, $_[0];     # never call complete
    });
    $wkr->work;
    for (1..5) {
        $cli->submit_job('xt_leak_async_'.$$, "x", sub {});
    }
    my $w = EV::timer 1, 0, sub { EV::break };
    EV::run;
    # On teardown, $cli's pending callbacks fire with "disconnected",
    # $wkr drops the function (whose refcnt may hold $stash entries),
    # and DESTROY frees everything cleanly.
    undef $cli;
    undef $wkr;
    @stash = ();
    pass 'async stash cleanup';
}

# 5. Admin commands intermixed with submissions
{
    my $g = EV::Gearman->new(host => $host, port => $port);
    my $settle;   # retained so the timer actually fires
    $g->on_connect(sub {
        for (1..10) {
            $g->server_status(sub {});
            $g->server_version(sub {});
            $g->echo("ping", sub {});
        }
        $settle = EV::timer 0.3, 0, sub { EV::break };
    });
    my $w = EV::timer 3, 0, sub { EV::break };
    EV::run;
    undef $g;
    pass 'admin intermix cleanup';
}

# 6. Async worker DESTROYed with stashed jobs outstanding (T-D1-4):
#    the client struct must become an inert tombstone kept alive by the
#    jobs' magic references, job methods must croak "client destroyed",
#    and releasing the jobs must free the tombstone — no definite leak,
#    no use-after-free. (This is the scenario xt/90 and xt/91 drive.)
{
    my $w = EV::Gearman->new(host => $host, port => $port);
    my $c = EV::Gearman->new(host => $host, port => $port);
    my @stash;
    $w->register_function('xt_leak_tomb_'.$$ => { async => 1 }, sub {
        push @stash, $_[0];
        EV::break if @stash == 2;
    });
    $w->work;
    $c->on_connect(sub {
        $c->submit_job_bg('xt_leak_tomb_'.$$, 'one');
        $c->submit_job_bg('xt_leak_tomb_'.$$, 'two');
    });
    my $t = EV::timer 5, 0, sub { EV::break };
    EV::run;
    is scalar(@stash), 2, 'two async jobs dispatched and stashed';

    undef $w;            # DESTROY with jobs outstanding -> tombstone
    my $err = do { local $@; eval { $stash[0]->complete('x'); 1 } ? '' : $@ };
    like $err, qr/client destroyed/,
        'stashed job croaks "client destroyed" after worker DESTROY';
    undef @stash;        # tombstone freed here, via the jobs' svt_free
    undef $c;
    pass 'tombstone released with jobs';
}

done_testing;