view release on metacpan or  search on metacpan

t/92-end_phased_cleanup.t  view on Meta::CPAN

        open my $fh, '>', $time_file or die "open: $!";
        print $fh "$elapsed\n";
        close $fh;

        Async::Event::Interval::_end();
        IPC::Shareable::_end();
        POSIX::_exit(0);
    }

    waitpid $pid, 0;

    ok -e $time_file, "_alarmed_eval: child wrote timing file";

    SKIP: {
        skip "_alarmed_eval: no timing file", 1 unless -e $time_file;
        open my $fh, '<', $time_file;
        chomp(my $elapsed = <$fh>);
        close $fh;
        cmp_ok $elapsed, '<', 3,
            "_alarmed_eval interrupted blocked call in ${elapsed}s (< 3s)";
    }

    unlink $time_file if -e $time_file;
}

# ---------------------------------------------------------------------------
# Test 2: @all_pids fallback — children are killed even when %events
#          read would fail
# ---------------------------------------------------------------------------
# We can't easily deadlock the real %events lock in a test, but we can
# verify the mechanics: start an event, confirm the child PID appears
# in @all_pids (via the public _all_pids accessor we'll skip if absent),
# then let _end() clean up normally.
{
    my $flag_file = File::Temp::tmpnam();

    my $pid = fork;
    die "fork: $!" unless defined $pid;

    if (! $pid) {
        IPC::Shareable->testing_set('Async::Event::Interval');
        require Async::Event::Interval;

        my $event = Async::Event::Interval->new(5, sub {
            open my $fh, '>', $flag_file;
            close $fh;
            sleep 30;
        });
        $event->immediate(1);
        $event->start;

        for (1..50) {
            last if -e $flag_file;
            select(undef, undef, undef, 0.1);
        }

        my $child_pid = $event->pid;

        Async::Event::Interval::_end(1);

        my $child_alive = kill(0, $child_pid);
        open my $fh, '>', "$flag_file.result" or die "open: $!";
        print $fh "$child_alive\n";
        close $fh;

        IPC::Shareable::_end();
        POSIX::_exit(0);
    }

    waitpid $pid, 0;

    SKIP: {
        skip "result file not written", 1
            unless -e "$flag_file.result";
        open my $fh, '<', "$flag_file.result";
        chomp(my $alive = <$fh>);
        close $fh;
        is $alive, 0,
            "_end() killed event child (via %events or \@all_pids fallback)";
    }

    unlink $flag_file if -e $flag_file;
    unlink "$flag_file.result" if -e "$flag_file.result";
}

# ---------------------------------------------------------------------------
# Test 3: Per-phase cleanup — later phases run even when earlier ones fail
# ---------------------------------------------------------------------------
# Fork a subprocess that starts an event, then calls _end().  Verify
# that IPC segments are cleaned up (phase 4 runs) even though earlier
# phases may complete or timeout independently.
{
    my $pid = fork;
    die "fork: $!" unless defined $pid;

    if (! $pid) {
        IPC::Shareable->testing_set('Async::Event::Interval');
        require Async::Event::Interval;

        my $e = Async::Event::Interval->new(0, sub {});
        $e->start;
        select(undef, undef, undef, 0.3);

        Async::Event::Interval::_end(1);
        IPC::Shareable::_end();
        POSIX::_exit(0);
    }

    waitpid $pid, 0;
    select(undef, undef, undef, 0.3);

    my $segs_after = IPC::Shareable::seg_count();
    my $sems_after = IPC::Shareable::sem_count();

    is $segs_after, $segs_before,
        "per-phase _end(): no segments leaked";
    is $sems_after, $sems_before,
        "per-phase _end(): no semaphores leaked";
}

# ---------------------------------------------------------------------------
# Test 4: SIGINT triggers phased _end() and cleans up
# ---------------------------------------------------------------------------
# Same as t/91 but confirms the new phased structure works under signal.
{
    my $flag_file = File::Temp::tmpnam();

    my $pid = fork;
    die "fork: $!" unless defined $pid;

    if (! $pid) {
        IPC::Shareable->testing_set('Async::Event::Interval');
        require Async::Event::Interval;

        my $event = Async::Event::Interval->new(5, sub {
            open my $fh, '>', $flag_file;
            close $fh;
            sleep 4;