view release on metacpan or  search on metacpan

t/unit/peer_active_timeout.t  view on Meta::CPAN

use Test2::V0;

use Time::HiRes qw/time/;
use IPC::Manager::Client;

local $SIG{ALRM} = sub { die "test timed out after 30s\n" };
alarm 30;

{
    package TestPeerReady::MockClient;
    use parent -norequire, 'IPC::Manager::Client';

    # Instance-level toggles so tests can flip state mid-call via SIGALRM.
    sub new {
        my ($class, %args) = @_;
        my $self = {
            alive    => 0,
            peer_pid => $$,     # use our own pid so pid_is_running returns 1
            pid      => $$,     # satisfy pid_check in disconnect
            want_peer_change_handles => 0,
            %args,
        };
        return bless $self, $class;
    }

    sub peer_pid                     { $_[0]->{alive} ? $_[0]->{peer_pid} : 0 }
    sub have_handles_for_peer_change { $_[0]->{want_peer_change_handles} }
    sub handles_for_peer_change      { () }
    sub reset_handles_for_peer_change { }
    sub disconnect                   { }
    sub write_stats                  { }
    sub activate_peer                { $_[0]->{alive} = 1 }
}

subtest 'no timeout = one-shot behavior (backward compat)' => sub {
    my $c = TestPeerReady::MockClient->new;
    is($c->peer_active('foo'), 0, "inactive one-shot returns 0");

    $c->activate_peer;
    is($c->peer_active('foo'), 1, "active one-shot returns 1");
};

subtest 'positive timeout: returns immediately when peer is already active' => sub {
    my $c = TestPeerReady::MockClient->new(alive => 1);

    my $start = time;
    my $got = $c->peer_active('foo', 5);
    my $elapsed = time - $start;

    ok($got, "returns truthy when peer is active");
    ok($elapsed < 0.5, "returned quickly (${elapsed}s)");
};

subtest 'positive timeout: returns 0 after timeout when peer never becomes active' => sub {
    my $c = TestPeerReady::MockClient->new;    # inactive

    my $start = time;
    my $got = $c->peer_active('foo', 0.3);
    my $elapsed = time - $start;

    ok(!$got, "returned false after timeout");
    ok($elapsed >= 0.25, "waited close to full timeout (${elapsed}s)");
    ok($elapsed < 10,    "did not wait much past timeout (${elapsed}s)");
};

subtest 'timeout 0 = block forever until peer becomes active' => sub {
    my $c = TestPeerReady::MockClient->new;

    # Arrange for the peer to flip to active via SIGALRM in ~0.4s.
    local $SIG{ALRM} = sub { $c->activate_peer };
    Time::HiRes::alarm(0.4);

    my $start = time;
    my $got = $c->peer_active('foo', 0);
    my $elapsed = time - $start;

    alarm 30;    # restore outer fail-safe

    ok($got, "eventually returned true once the peer became active");
    ok($elapsed >= 0.3, "waited until the peer became active (${elapsed}s)");
    ok($elapsed < 5,    "did not hang past the activation event (${elapsed}s)");
};

subtest 'polling path: uses IO::Select when client has peer-change handles' => sub {
    pipe(my ($rh, $wh)) or die "pipe: $!";

    my $c = TestPeerReady::MockClient->new(
        want_peer_change_handles => 1,
    );

    # Override to return the pipe read end.
    no warnings 'redefine';
    local *TestPeerReady::MockClient::handles_for_peer_change = sub { $rh };

    # Make the read end ready for reading: a write wakes IO::Select up.
    syswrite($wh, "x") or die "syswrite: $!";

    # Peer is already active — this should return right away regardless,
    # but the main point is verifying the IO::Select path does not
    # deadlock or produce errors when have_handles_for_peer_change is
    # true.
    $c->activate_peer;
    my $start = time;
    my $got = $c->peer_active('foo', 2);