view release on metacpan or  search on metacpan

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

use strict;
use warnings;

use File::Temp;
use IPC::Shareable;
use POSIX ();
use Test::More;

my $segs_before = IPC::Shareable::seg_count();
my $sems_before = IPC::Shareable::sem_count();

# ---------------------------------------------------------------------------
# Test 1: _alarmed_eval actually interrupts a blocked call (SA_RESTART cleared)
# ---------------------------------------------------------------------------
# Fork a child that calls _alarmed_eval with a 1s timeout around a 5s
# sleep.  The child writes the elapsed wall-clock time to a temp file.
# If SA_RESTART were still set, the alarm would be swallowed and the
# sleep would complete (~5s).  With the fix, it should exit in ~1s.
{
    my $time_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 $start = Time::HiRes::time();
        Async::Event::Interval::_alarmed_eval(1, sub {
            select(undef, undef, undef, 5);
        });
        my $elapsed = Time::HiRes::time() - $start;

        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)";
    }