Async-Event-Interval

 view release on metacpan or  search on metacpan

t/09-locking.t  view on Meta::CPAN

        POSIX::_exit(0);
    }

    close $ready_w;
    my $ready = <$ready_r>;
    chomp $ready;
    is $ready, 'ready', "_end timeout: child holds LOCK_EX";
    close $ready_r;

    is $knot->sem->getval(SEM_WRITERS), 1,
        "_end timeout: SEM_WRITERS confirms the child's LOCK_EX is held";

    no warnings 'redefine';
    local *IPC::Shareable::clean_up_protected = sub {};

    my $timeout = Async::Event::Interval::END_LOCK_TIMEOUT();

    use Time::HiRes ();
    my $t0 = Time::HiRes::time();
    Async::Event::Interval::_end();
    my $elapsed = Time::HiRes::time() - $t0;

    # Upper bound loosened for slow-VM SIGALRM-delivery jitter; the
    # behavioral claim is still "_end() bails out instead of blocking
    # forever," which is enforced by a finite ceiling well below the
    # child's sleep 30. The lower bound (unchanged) keeps the "actually
    # waited" assertion.
    cmp_ok $elapsed, '<', $timeout + 8,
        "_end() bailed out instead of blocking "
      . "($elapsed s, timeout=$timeout)";
    cmp_ok $elapsed, '>=', $timeout - 0.5,
        "_end() actually waited ~END_LOCK_TIMEOUT seconds before bailing "
      . "($elapsed s)";

    kill 'TERM', $pid;
    waitpid $pid, 0;
}

# After a timeout-aborted _end(), the next _end() call (with no
# contention) still works — the eval / local $SIG{ALRM} pair leaves no
# leaked alarm or handler state behind.

{
    no warnings 'redefine';
    my $cleanup_calls = 0;
    local *IPC::Shareable::clean_up_protected = sub { $cleanup_calls++ };

    Async::Event::Interval::_end();
    cmp_ok $cleanup_calls, '>=', 1,
        "_end() recovers normally after a prior timeout";

    # No leaked alarm — alarm(0) returns the seconds remaining on any
    # pending alarm, so a clean state returns 0.
    is alarm(0), 0,
        "_end() leaves no pending alarm in the global state";
}

# 2.2: stop() polls kill(0) at STOP_KILL_POLL_INTERVAL cadence for up to
# STOP_KILL_TIMEOUT seconds instead of always sleeping a fixed 1s. It
# returns as soon as the target process is gone, and croaks only if the
# process is still alive after the timeout.

# Constants exist and have sane values; poll interval < total timeout.

{
    can_ok 'Async::Event::Interval', 'STOP_KILL_TIMEOUT';
    can_ok 'Async::Event::Interval', 'STOP_KILL_POLL_INTERVAL';
    cmp_ok Async::Event::Interval::STOP_KILL_TIMEOUT(), '>', 0,
        "STOP_KILL_TIMEOUT is positive";
    cmp_ok Async::Event::Interval::STOP_KILL_POLL_INTERVAL(), '>', 0,
        "STOP_KILL_POLL_INTERVAL is positive";
    cmp_ok Async::Event::Interval::STOP_KILL_POLL_INTERVAL(), '<',
        Async::Event::Interval::STOP_KILL_TIMEOUT(),
        "poll interval is smaller than the total timeout";
}

# Already-dead pid: stop() returns essentially immediately because the
# first `kill 0` returns 0 and the while-loop body never executes.

{
    my $pid = fork;
    die "fork: $!" unless defined $pid;
    if (! $pid) {
        require POSIX;
        POSIX::_exit(0);
    }
    # $SIG{CHLD} = 'IGNORE' (set by AEI at load time) auto-reaps; sleep
    # briefly so the child has actually exited.
    select(undef, undef, undef, 0.05);

    my $e = Async::Event::Interval->new(0, sub {});
    $e->_pid($pid);

    use Time::HiRes ();
    my $t0 = Time::HiRes::time();
    $e->stop;
    my $elapsed = Time::HiRes::time() - $t0;

    cmp_ok $elapsed, '<',
        Async::Event::Interval::STOP_KILL_POLL_INTERVAL(),
        "stop() on an already-dead pid returns under one poll interval "
      . "($elapsed s)";
    is $e->_started, 0,
        "stop() cleared _started flag";

    $e->_pid(0);
}

# Live child: stop() actually sends SIGKILL and returns well under the
# old fixed 1s sleep — the polling loop catches the child's death on
# the first or second poll.

{
    my $pid = fork;
    die "fork: $!" unless defined $pid;
    if (! $pid) {
        sleep 30;   # parent's stop() will SIGKILL us long before this
        require POSIX;
        POSIX::_exit(0);
    }

t/09-locking.t  view on Meta::CPAN

    # Polling actually polled: at STOP_KILL_POLL_INTERVAL=0.05 over
    # ~1.5s we expect ~30 kill(0) checks. Allow a generous floor.
    cmp_ok scalar @kill_zero_calls, '>=', 10,
        "stop() polled kill(0) across both signal phases (got "
      . scalar(@kill_zero_calls) . ")";

    is $e->_started, 0,
        "stop() cleared _started flag even before croaking";

    $e->_pid(0);
}

# stop() with no pid is a no-op (covers the early `if ($self->pid)`
# guard so the polling loop doesn't run on a fresh, never-started event).

{
    my $e = Async::Event::Interval->new(0, sub {});
    # new() does not call _pid, so $e->pid is undef at this point.
    is $e->pid, undef, "fresh event has no pid before start()";

    use Time::HiRes ();
    my $t0 = Time::HiRes::time();
    $e->stop;
    my $elapsed = Time::HiRes::time() - $t0;

    cmp_ok $elapsed, '<', 0.01,
        "stop() on a never-started event is an instant no-op ($elapsed s)";
}

# 3.3: stop() sends SIGTERM first, escalates to SIGKILL only if TERM fails.
# Tests verify the new STOP_TERM_TIMEOUT constant, the _signal_and_wait
# helper, the TERM-then-KILL ordering, and the short-circuit when TERM
# succeeds.

# STOP_TERM_TIMEOUT exists and has a sane value.

{
    can_ok 'Async::Event::Interval', 'STOP_TERM_TIMEOUT';
    cmp_ok Async::Event::Interval::STOP_TERM_TIMEOUT(), '>', 0,
        "STOP_TERM_TIMEOUT is positive";
    cmp_ok Async::Event::Interval::STOP_TERM_TIMEOUT(), '<=', 5,
        "STOP_TERM_TIMEOUT <= 5 seconds (sanity bound)";
    cmp_ok Async::Event::Interval::STOP_TERM_TIMEOUT(), '<',
        Async::Event::Interval::STOP_KILL_TIMEOUT(),
        "STOP_TERM_TIMEOUT is shorter than STOP_KILL_TIMEOUT";
}

# _signal_and_wait is a method on Async::Event::Interval.

{
    can_ok 'Async::Event::Interval', '_signal_and_wait';
}

# SIGTERM success: when a child dies from SIGTERM, stop() returns
# without ever escalating to SIGKILL. Uses the CORE::GLOBAL::kill mock
# to track signal order and simulate TERM-induced death.

{
    my @signals_sent;
    my $kill_zero_alive = 0;       # count of kill(0) calls seen so far
    local $kill_mock = sub {
        my ($sig, @pids) = @_;
        push @signals_sent, $sig;

        if ($sig eq 'TERM') {
            # After SIGTERM is delivered, subsequent kill(0) calls
            # should report the process as dead.
            $kill_zero_alive = 0;
            return 1;
        }
        if ($sig eq '0') {
            $kill_zero_alive++;
            # Return alive for the first kill(0) (pre-TERM probe in
            # _signal_and_wait's while loop), then dead afterwards
            # (simulating TERM-induced death).
            return $kill_zero_alive <= 1 ? 1 : 0;
        }
        return 1;
    };

    my $e = Async::Event::Interval->new(0, sub {});
    $e->_pid(99999);

    eval { $e->stop };

    # stop() must have sent TERM (it always tries TERM first).
    ok ((grep { $_ eq 'TERM' } @signals_sent) >= 1,
        "SIGTERM success: SIGTERM was sent");

    # SIGKILL must NOT have been sent — TERM killed the child.
    ok (! (grep { $_ eq 'KILL' } @signals_sent),
        "SIGTERM success: SIGKILL was NOT sent (TERM sufficed)");

    is $e->_started, 0,
        "SIGTERM success: _started cleared";

    $e->_pid(0);
}

# Live child actually dies from SIGTERM: fork a child that sleeps,
# call stop(), verify it returns quickly (under STOP_TERM_TIMEOUT) and
# the child is gone. SIGTERM's default action (terminate) kills the
# sleeping child on the first poll.

{
    my $pid = fork;
    die "fork: $!" unless defined $pid;
    if (! $pid) {
        sleep 30;
        require POSIX;
        POSIX::_exit(0);
    }

    my $e = Async::Event::Interval->new(0, sub {});
    $e->_pid($pid);
    $e->_started(1);

    select(undef, undef, undef, 0.05);

    use Time::HiRes ();
    my $t0 = Time::HiRes::time();
    $e->stop;
    my $elapsed = Time::HiRes::time() - $t0;

    my $term_timeout = Async::Event::Interval::STOP_TERM_TIMEOUT();
    cmp_ok $elapsed, '<', $term_timeout,
        "live child: stop() returns under STOP_TERM_TIMEOUT when SIGTERM works "
      . "($elapsed s, term_timeout=$term_timeout)";
    is $e->_started, 0,
        "live child: _started cleared";
    ok ! (kill 0, $pid),
        "live child: pid is gone after stop()";

    $e->_pid(0);
}

t/09-locking.t  view on Meta::CPAN

    $e->_pid($pid);

    use Time::HiRes ();
    my $t0 = Time::HiRes::time();
    my $rv = $e->_signal_and_wait('TERM',
        Async::Event::Interval::STOP_TERM_TIMEOUT());
    my $elapsed = Time::HiRes::time() - $t0;

    is $rv, 1,
        "_signal_and_wait returns 1 when pid is already dead";
    cmp_ok $elapsed, '<',
        Async::Event::Interval::STOP_KILL_POLL_INTERVAL(),
        "_signal_and_wait returns immediately for already-dead pid "
      . "($elapsed s)";
    $e->_pid(0);
}

# _signal_and_wait with a live child: sends the signal, polls until
# the child dies, returns 1 within one poll interval.

{
    my $pid = fork;
    die "fork: $!" unless defined $pid;
    if (! $pid) {
        sleep 30;
        require POSIX;
        POSIX::_exit(0);
    }

    select(undef, undef, undef, 0.05);

    my $e = Async::Event::Interval->new(0, sub {});
    $e->_pid($pid);

    use Time::HiRes ();
    my $t0 = Time::HiRes::time();
    my $rv = $e->_signal_and_wait('TERM',
        Async::Event::Interval::STOP_TERM_TIMEOUT());
    my $elapsed = Time::HiRes::time() - $t0;

    is $rv, 1,
        "_signal_and_wait returns 1 when child dies from signal";
    cmp_ok $elapsed, '<',
        Async::Event::Interval::STOP_TERM_TIMEOUT(),
        "_signal_and_wait returns within STOP_TERM_TIMEOUT "
      . "($elapsed s)";
    ok ! (kill 0, $pid),
        "_signal_and_wait: child pid is gone";

    $e->_pid(0);
}

# _signal_and_wait timeout: when kill(0) keeps returning truthy past
# the timeout, returns 0 (used by stop() to decide escalation).

{
    my @kill_calls;
    local $kill_mock = sub {
        my ($sig, @pids) = @_;
        push @kill_calls, $sig;
        return 1;   # always alive
    };

    my $e = Async::Event::Interval->new(0, sub {});
    $e->_pid(99999);

    use Time::HiRes ();
    my $t0 = Time::HiRes::time();
    my $rv = $e->_signal_and_wait('TERM',
        Async::Event::Interval::STOP_TERM_TIMEOUT());
    my $elapsed = Time::HiRes::time() - $t0;

    is $rv, 0,
        "_signal_and_wait returns 0 on timeout";
    my $term_timeout = Async::Event::Interval::STOP_TERM_TIMEOUT();
    cmp_ok $elapsed, '>=', $term_timeout - 0.2,
        "_signal_and_wait waited ~STOP_TERM_TIMEOUT before returning 0 "
      . "($elapsed s)";

    $e->_pid(0);
}