view release on metacpan or  search on metacpan

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

    }

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

    ok -e $flag_file, "SIGTERM test: event callback invoked";

    kill 'TERM', $pid;
    waitpid $pid, 0;
    select(undef, undef, undef, 0.3);

    unlink $flag_file if -e $flag_file;

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

    is $segs_after, $segs_before,
        "SIGTERM: no segments leaked after phased _end()";
    is $sems_after, $sems_before,
        "SIGTERM: no semaphores leaked after phased _end()";
}

# ---------------------------------------------------------------------------
# Test 6: Multiple events — all children killed, all segments cleaned
# ---------------------------------------------------------------------------
{
    my $flag1 = File::Temp::tmpnam();
    my $flag2 = 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 $e1 = Async::Event::Interval->new(5, sub {
            open my $fh, '>', $flag1; close $fh;
            sleep 30;
        });
        my $e2 = Async::Event::Interval->new(5, sub {
            open my $fh, '>', $flag2; close $fh;
            sleep 30;
        });
        $e1->immediate(1);
        $e2->immediate(1);
        $e1->start;
        $e2->start;

        sleep 60;
        exit;
    }

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

    ok(-e $flag1 && -e $flag2, "Multi-event: both callbacks invoked");

    kill 'INT', $pid;
    waitpid $pid, 0;
    select(undef, undef, undef, 0.3);

    unlink $flag1 if -e $flag1;
    unlink $flag2 if -e $flag2;

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

    is $segs_after, $segs_before,
        "Multi-event SIGINT: no segments leaked";
    is $sems_after, $sems_before,
        "Multi-event SIGINT: no semaphores leaked";
}

# ---------------------------------------------------------------------------
# Test 7: _alarmed_eval restores caller's SIGALRM handler
# ---------------------------------------------------------------------------
# alarm() is process-global so _alarmed_eval necessarily resets it, but
# the Perl-level $SIG{ALRM} handler and the POSIX sigaction disposition
# should be restored via the local + sigaction save/restore.
{
    my $result_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 $outer_fired = 0;
        local $SIG{ALRM} = sub { $outer_fired = 1 };

        Async::Event::Interval::_alarmed_eval(1, sub {});

        # Fire the restored handler to prove it survived
        alarm(1);
        select(undef, undef, undef, 2);
        alarm(0);

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

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

    waitpid $pid, 0;

    SKIP: {
        skip "result file not written", 1 unless -e $result_file;
        open my $fh, '<', $result_file;
        chomp(my $outer_fired = <$fh>);
        close $fh;
        is $outer_fired, 1,