view release on metacpan or search on metacpan
0.03 Thu Sep 06 2012
* API: Make empty/zero $timeout illegal.
0.0203 Tue Aug 14 2012
* Fixed empty $timeout undef warning.
* Minor code cleanup.
0.02 Sat Aug 11 2012
First version, released on an unsuspecting world.
- ae_recv, ae_send and ae_croak wotk and pass most basic tests
To install AE::AdHoc, run the following commands:
perl Makefile.PL
make
make test
make install
{
"abstract" : "Simplified interface for tests/examples of AnyEvent-related code.",
"author" : [
"Konstantin S. Uvarin <khedin@gmail.com>"
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.112621",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
---
abstract: 'Simplified interface for tests/examples of AnyEvent-related code.'
author:
- 'Konstantin S. Uvarin <khedin@gmail.com>'
build_requires:
ExtUtils::MakeMaker: 0
configure_requires:
ExtUtils::MakeMaker: 0
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.112621'
license: perl
meta-spec:
AE-AdHoc
AE::AdHoc is a simple interface around AnyEvent intended for tests, examples,
and hastily written scripts.
It boils down to:
use AE::AdHoc;
my $result = ae_recv {
do_something ( # the code under test
on_success => ae_send, # callback - all done, stop event loop
on_failure => ae_croak, # callback - something happened, abort event loop
);
} 10; # timeout - fail test if it takes too long
# later
is ($result, $excepted_result, "...");
This module is under development for now.
INSTALLATION
To install this module, run the following commands:
perl Makefile.PL
make
make test
make install
SUPPORT AND DOCUMENTATION
After installing, you can find documentation for this module with the
perldoc command.
perldoc AE::AdHoc
You can also look for information at:
lib/AE/AdHoc.pm view on Meta::CPAN
package AE::AdHoc;
use warnings;
use strict;
=head1 NAME
AE::AdHoc - Simplified interface for tests/examples of AnyEvent-related code.
=head1 NON-DESCRIPTION
This module is NOT for introducing oneself to AnyEvent, despite the mention of
"simplified". More over, it REQUIRES knowledge of what a conditional variable,
or simply "condvar", is. See L<Anyevent::Intro>.
This module is NOT for building other modules, it's for running them with
minimal typing.
=head1 SYNOPSIS
Suppose we have a subroutine named C<do_stuff( @args, $subref )>
that is designed to run under AnyEvent. As do_stuff may have to wait for
some external events to happen, it does not return a value right away.
Instead, it will call C<$subref-E<gt>( $results )> when stuff is done.
Now we need to test do_stuff, so we set up an event loop. We also need a timer,
because a test that runs forever is annoying. So the script goes like this:
use AnyEvent;
# set up event loop
my $cv = AnyEvent->condvar;
my $timer = AnyEvent->timer(
after => 10, cb => sub { $cv->croak("Timeout"); }
);
do_stuff( @args, sub{ $cv->send(shift); } );
t/00-load.t view on Meta::CPAN
#!perl -T
use Test::More tests => 1;
BEGIN {
use_ok( 'AE::AdHoc' ) || print "Bail out!
";
}
diag( "Testing AE::AdHoc $AE::AdHoc::VERSION, Perl $], $^X" );
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 );
t/10-basic.t view on Meta::CPAN
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
#!/usr/bin/perl -w
use strict;
use Test::More;
use Test::Exception;
use AE::AdHoc;
my @timers;
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 {
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 strict;
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 {
t/14-xargs.t view on Meta::CPAN
#!/usr/bin/perl -w
use strict;
use Test::More tests => 5;
use Test::Exception;
use AE::AdHoc;
my @list;
my $scalar;
@list = ae_recv {
ae_send(1..5)->(6..10);
} 0.01;
t/15-goals.t view on Meta::CPAN
#!/usr/bin/perl -w
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");
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";
t/17-goals-leftover.t view on Meta::CPAN
#!/usr/bin/perl -w
use strict;
use Test::More tests => 3;
use Data::Dumper;
use AE::AdHoc;
$AE::AdHoc::warnings = 0;
my $timer;
ae_recv {
$timer = AnyEvent->timer( after => 0, cb => ae_goal("pollute") );
ae_send->("return right now");
} 0.1;
t/18-all-leftover.t view on Meta::CPAN
#!/usr/bin/perl -w
use strict;
use Test::More tests => 5;
use Test::Exception;
use AE::AdHoc;
$AE::AdHoc::warnings = 0;
my $sub;
ae_recv { $sub = ae_send; ae_send->("stop now"); } 0.01;
lives_ok { $sub->() } "Don't die if event loop MAY exist";
like ($AE::AdHoc::errstr, qr(Leftover.*outside), "Error was catched");
t/19-soft-timeout.t view on Meta::CPAN
#!/usr/bin/perl -w
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
t/20-ae_action.t view on Meta::CPAN
#!/usr/bin/perl -w
use strict;
use Test::More tests => 5;
use Test::Exception;
use AE::AdHoc;
my @res;
ae_recv {
ae_action { push @res, @_ } after=>0.03, interval =>0.1;
} soft_timeout=>0.2;
is_deeply (\@res, [ 0, 1 ], "Timer fired twice");
my $x;
ae_recv {
ae_action { $x++ };
ok (!$x, "Action didn't work yet");
} soft_timeout=>0.2;
is ($x, 1, "Action w/o parameters works (finally)");
is_deeply (\@res, [ 0, 1 ], "Timer *still* fired twice");
is_deeply (\@AE::AdHoc::errors, [], "No errors in this test");
t/boilerplate.t view on Meta::CPAN
#!perl -T
use strict;
use warnings;
use Test::More tests => 3;
sub not_in_file_ok {
my ($filename, %regex) = @_;
open( my $fh, '<', $filename )
or die "couldn't open $filename for reading: $!";
my %violated;
while (my $line = <$fh>) {
while (my ($desc, $regex) = each %regex) {
t/manifest.t view on Meta::CPAN
#!perl -T
use strict;
use warnings;
use Test::More;
unless ( $ENV{RELEASE_TESTING} ) {
plan( skip_all => "Author tests not required for installation" );
}
eval "use Test::CheckManifest 0.9";
plan skip_all => "Test::CheckManifest 0.9 required" if $@;
ok_manifest();
t/pod-coverage.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
# Ensure a recent version of Test::Pod::Coverage
my $min_tpc = 1.08;
eval "use Test::Pod::Coverage $min_tpc";
plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
if $@;
# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
# but older versions don't recognize some common documentation styles
my $min_pc = 0.18;
eval "use Pod::Coverage $min_pc";
plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
if $@;
all_pod_coverage_ok();
#!perl -T
use strict;
use warnings;
use Test::More;
# Ensure a recent version of Test::Pod
my $min_tp = 1.22;
eval "use Test::Pod $min_tp";
plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
all_pod_files_ok();