view release on metacpan or  search on metacpan

t/61-error_and_waiting_fields.t  view on Meta::CPAN

use strict;
use warnings;

use lib 't/lib';
use TestHelper;
use Test::More;
use Time::HiRes ();

use Async::Event::Interval;

my $mod = 'Async::Event::Interval';

# Poll-until-condition with a wall-clock deadline. Replaces fixed select()
# sleeps in blocks that wait for an asynchronous state transition (callback
# crash registers, restart clears flag, etc.) so the tests are robust on
# slow VMs without inflating wall-clock on healthy runs. Returns 1 on
# condition met, 0 on deadline hit.

sub poll_until {
    my ($cond, $timeout) = @_;
    $timeout //= 5;
    my $deadline = Time::HiRes::time() + $timeout;
    while (! $cond->()) {
        return 0 if Time::HiRes::time() >= $deadline;
        select(undef, undef, undef, 0.05);
    }
    return 1;
}

# --- 'error' field --------------------------------------------------------

# 1: brand-new event (never started) → error=0
{
    my $e = $mod->new(0, sub {});
    is $e->info->{error}, 0, "new event: info() error=0";
    my $snap = $mod->events;
    is $snap->{$e->id}{error}, 0, "new event: events() error=0";
}

# 2: healthy running event → error=0
{
    my $e = $mod->new(0.1, sub {});
    $e->start;
    select(undef, undef, undef, 0.25);
    is $e->info->{error}, 0, "running event: info() error=0";
    my $snap = $mod->events;
    is $snap->{$e->id}{error}, 0, "running event: events() error=0";
    $e->stop;
}

# 3: callback dies (one-shot) → error=1
{
    my $e = $mod->new(0, sub { die "boom\n" });
    $e->start;
    poll_until(sub { $e->info->{error} == 1 });
    is $e->info->{error}, 1, "one-shot crash: info() error=1";
    my $snap = $mod->events;
    is $snap->{$e->id}{error}, 1, "one-shot crash: events() error=1";
}

# 4: callback dies (interval mode) → error=1
{
    my $e = $mod->new(0.1, sub { die "boom\n" });
    $e->start;
    poll_until(sub { $e->info->{error} == 1 });
    is $e->info->{error}, 1, "interval crash: info() error=1";
    my $snap = $mod->events;
    is $snap->{$e->id}{error}, 1, "interval crash: events() error=1";
}

# 5: error=1 persists until restart
{
    my $e = $mod->new(0, sub { die "boom\n" });
    $e->start;