view release on metacpan or  search on metacpan

t/repro_unsafe_abandon.t  view on Meta::CPAN

    churn(40);

    ok(!$err, 'EV::run completed without error') or diag $err;
    is($t3_ran, 0, 'series does not continue past the failed task');
    is($final, 0, 'final_cb not called');
    @w = ();
};

subtest 'parallel unsafe: late completion does not fire final_cb' => sub {
    our @w;
    my $final = 0;

    eval {
        parallel([
            sub { my $d = shift; push @w, EV::timer 0.01, 0, sub { $d->() } },
            sub { my $d = shift; $d->(); die "boom\n" },
        ], sub { $final++ }, 1);
    };
    is($@, "boom\n", 'exception propagated to caller');

    my $err = run_loop();
    churn(40);

    ok(!$err, 'EV::run completed without error') or diag $err;
    is($final, 0, 'final_cb not called by the late completion');
    @w = ();
};

subtest 'race unsafe: late winner does not fire final_cb' => sub {
    our @w;
    my $final = 0;

    eval {
        race([
            sub { my $d = shift; push @w, EV::timer 0.01, 0, sub { $d->("late") } },
            sub { die "boom\n" },
        ], sub { $final++ }, 1);
    };
    is($@, "boom\n", 'exception propagated to caller');

    my $err = run_loop();
    churn(40);

    ok(!$err, 'EV::run completed without error') or diag $err;
    is($final, 0, 'final_cb not called by the late winner');
    @w = ();
};

# An abandoned operation is frozen, not finished: nothing will ever advance it,
# and in unsafe mode its context is deliberately leaked because the unwind
# cannot run cleanup. A handle held over it is the only thing that can still
# reach that context, and cancel() is the documented way to reclaim it.
#
# The assertions below pin the observable half of that contract: stale non-zero
# counts while abandoned, zero after cancel, and final_cb firing only for
# cancel(1). The reclaim of the memory itself is deliberately not asserted here,
# because no leak checker can see it - the leaked context stays reachable
# through the shared done CV's payload pointer, which lives in a Perl SV arena,
# so valgrind reports it as still reachable rather than lost either way. It was
# measured instead by counting live allocations at exit: 20 abandonments leave
# 45 blocks from plimit_start alive without the cancel and 2 with it.
subtest 'cancel reclaims an abandoned operation' => sub {
    our @w;

    # limit 2: tasks 1 and 2 go out in the opening burst, so the handle is
    # assigned before task 3 is dispatched from the event loop and dies there.
    my ($final, $h) = (0);
    $h = parallel_limit([
        sub { my $d = shift; push @w, EV::timer 0.01, 0, sub { $d->() } },
        sub { my $d = shift; push @w, EV::timer 0.50, 0, sub { $d->() } },
        sub { die "boom\n" },
        sub { my $d = shift; $d->() },
    ], 2, sub { $final++ }, 1);

    my $bail = EV::timer 0.1, 0, sub { EV::break };
    eval { EV::run };

    is($final, 0, 'final_cb did not fire after the abandonment');
    cmp_ok($h->pending, '>', 0, 'an abandoned operation still reports pending tasks');
    cmp_ok($h->active,  '>', 0, 'and still reports tasks in flight');

    $h->cancel;
    is($h->pending, 0, 'cancel released the abandoned context: pending is zero');
    is($h->active,  0, 'cancel released the abandoned context: active is zero');
    is($final, 0, 'a plain cancel still did not fire final_cb');

    # Same shape again, this time recovered with the firing form.
    my ($final2, $h2) = (0);
    $h2 = parallel_limit([
        sub { my $d = shift; push @w, EV::timer 0.01, 0, sub { $d->() } },
        sub { my $d = shift; push @w, EV::timer 0.50, 0, sub { $d->() } },
        sub { die "boom\n" },
        sub { my $d = shift; $d->() },
    ], 2, sub { $final2++ }, 1);

    my $bail2 = EV::timer 0.1, 0, sub { EV::break };
    eval { EV::run };
    is($final2, 0, 'second operation abandoned too');

    $h2->cancel(1);
    is($final2, 1, 'cancel(1) fired final_cb once after the abandonment');
    is($h2->pending, 0, 'and released the context');
    @w = ();
};

subtest 'safe mode still completes normally' => sub {
    our @w;
    my $final = 0;

    # No exception: the guard must not abandon anything on a normal unwind.
    parallel_limit([
        sub { my $d = shift; push @w, EV::timer 0.01, 0, sub { $d->() } },
        sub { my $d = shift; push @w, EV::timer 0.02, 0, sub { $d->() } },
        sub { my $d = shift; push @w, EV::timer 0.01, 0, sub { $d->() } },
    ], 2, sub { $final++; EV::break });

    my $err = run_loop();
    ok(!$err, 'EV::run completed without error') or diag $err;
    is($final, 1, 'final_cb fired exactly once');
    @w = ();
};