AE-AdHoc

 view release on metacpan or  search on metacpan

t/10-basic.t  view on Meta::CPAN

#!/usr/bin/perl -w

use strict;
use Test::More tests => 9;
use Test::Exception;

use AE::AdHoc;

throws_ok {
	ae_recv { ; } 0.01;
} qr(Timeout), "empty body => reach timeout => die";

lives_and {
	is ((ae_recv { ae_send->(137); } 0.01), 137 );
} "plain ae_send is fine";

throws_ok {
	ae_send;
} qr(outside), "outside = no go";

throws_ok {
	ae_begin;
} qr(outside), "outside = no go";

my $timer;
throws_ok {
	ae_recv {
		$timer = AnyEvent->timer( after => 0.1, cb => ae_send );
		note "timer ref = $timer";
	} 0.01;
} qr(Timeout), "Start rotten timer test";

# check that later-on callback generates a warning
{
	my @warn;
	local $SIG{__WARN__} = sub { push @warn, @_ };
	throws_ok {
		ae_recv { ; } 0.2;
	} qr(Timeout), "Rotten timer didn't spoil later tests:";
	is (scalar @warn, 1, " - 1 warning issued");
	like ($warn[0], qr(Leftover), " - It was about 'Leftover': $warn[0]");
	ok (ref $timer, " - Rotten timer still alive at this point (but harmless): $timer");

};

t/11-begin-end.t  view on Meta::CPAN

plan tests => 5;

lives_ok {
	my $timer;
	ae_recv {
		ae_begin;
		$timer = AnyEvent->timer( after => 0.01, cb => ae_end );
	} 1;
} "A simple begin/end example works";

throws_ok {
	my $timer;
	ae_recv {
		ae_begin;
		ae_begin;
		$timer = AnyEvent->timer( after => 0.01, cb => ae_end );
	} 0.02;
} qr(Timeout), "A simple example with extra begin dies";

my @trace;
my $val;

t/12-nested-dies.t  view on Meta::CPAN

#!/usr/bin/perl -w

use strict;
use Test::More;
use Test::Exception;

use AE::AdHoc;
$AE::AdHoc::warnings = 0;

plan tests => 1;
throws_ok {
	ae_recv {
		ae_recv {
		} 1;
	} 2;
} qr(nested)i, "Nested calls not allowed";

t/13-null-timeout.t  view on Meta::CPAN

use Test::More;
use Test::Exception;

use AE::AdHoc;

my @warn;
$SIG{__WARN__} = sub { push @warn, shift };

plan tests => 4;

throws_ok {
	ae_recv{ };
} qr(timeout.*non-?zero), "No timeout = no go";

throws_ok {
	ae_recv{ } "foo";
} qr(timeout.*non-?zero), "Non-numeric timeout = no go";

throws_ok {
	ae_recv{ } 0.01;
} qr(^Timeout after), "Timeout with empty body";

is (scalar @warn, 0, "no warnings");
note "warning: $_" for @warn;

t/14-xargs.t  view on Meta::CPAN

is ($scalar, 1, "Extra args in scalar context");

$scalar = ae_recv {
	ae_send->(6..10);
} 0.01;

is ($scalar, 6, "Multiple args in scalar context");

# Error handling

throws_ok {
	ae_recv {
		ae_croak("bump bump")->("real error");
	} 0.01;
} qr(^bump bump), "Extra args in croak";

unlike ($@, qr(real error), "Sorry, no real error for you");

t/15-goals.t  view on Meta::CPAN

use strict;
use Test::More tests => 5;
use Test::Exception;
use AnyEvent::Strict;
use Data::Dumper;

use AE::AdHoc;

my $result;

throws_ok {
	ae_goal("foo");
} qr(outside), "no ae_recv = no go";
note $@;

# We use sub {} in timers here because timer passes random args to its
# callback. See L<::AnyEvent> timer section.

lives_ok {
	my ($t1, $t2);
	$result = ae_recv {

t/16-goals2.t  view on Meta::CPAN

#!/usr/bin/perl -w

use strict;
use Test::More tests => 8;
use Test::Exception;

use AE::AdHoc;

throws_ok {
	ae_recv {
		ae_goal("never");
		ae_goal("always")->();
	} 0.1;
} qr(^Timeout), "Goals not done, sorry";
is_deeply( AE::AdHoc->results, { always => [] }, "1 goal done");
is_deeply( AE::AdHoc->goals, { never => 1 }, "1 goal left");

ae_recv { ae_send->(137) } 0.1;

is_deeply( AE::AdHoc->results, { }, "results cleared");
is_deeply( AE::AdHoc->goals, { }, "goals cleared");

throws_ok {
	ae_recv {
		ae_goal("never") for 1..3;
		ae_goal("always")->($_) for 1..3;
	} 0.1;
} qr(^Timeout), "Goals not done, sorry";
is_deeply( AE::AdHoc->results, { always => [1] }, "only first goal callback counts");
is_deeply( AE::AdHoc->goals, { never => 3 }, "1 goal left, but 3 times");

t/19-soft-timeout.t  view on Meta::CPAN

use strict;
use Test::More tests => 2;
use Test::Exception;

use AE::AdHoc;

lives_ok {
	ae_recv { } soft_timeout => 0.1
} "soft timeout";

throws_ok {
	ae_recv { } timeout => 0.1
} qr(Timeout.*seconds), "hard timeout in options";