AnyEvent-ForkObject
view release on metacpan or search on metacpan
my $obj = new AnyEvent::ForkObject;
ok $obj, "Constructor";
$obj->do(require => 'Data::Dumper', cb => sub {
diag explain \@_ unless ok $_[0] eq 'ok', 'require Data::Dumper';
$obj->do(
module => 'Data::Dumper',
args => [ [ 1, 2, 3 ]],
cb => sub {
my ($s, $o) = @_;
ok $s eq 'ok', 'Data::Dumper created';
undef $obj;
$o->Dump(0, sub {
my ($st, $ob) = @_;
ok $st eq 'fatal', 'Object has been destroyed';
ok $ob =~ /destroyed/, 'Fatal message is right';
});
});
});
my $timer = AE::timer 1, 0 => sub { $cv->send };
$cv->recv;
}
{
my $cv = condvar AnyEvent;
my $obj = new AnyEvent::ForkObject;
my $obj2 = new AnyEvent::ForkObject;
ok $obj, "Constructor";
kill KILL => $obj->{pid};
waitpid $obj->{pid}, 0;
$obj->do(require => 'Data::Dumper', cb => sub {
diag explain \@_ unless ok $_[0] eq 'fatal', 'Child was killed';
my $t;
$t = AE::timer 0.3, 0 => sub {
undef $t;
$cv->send;
}
});
my $dont_call_if_destroyed = 1;
$obj2->do(require => 'Data::Dumper', cb => sub {
diag explain \@_;
$dont_call_if_destroyed = 0;
});
kill KILL => $obj2->{pid};
undef $obj2;
my $timeout; $timeout = AE::timer 1, 0 => sub { undef $timeout; $cv->send };
$cv->recv;
ok $dont_call_if_destroyed, "Don't touch callbacks if destroyed";
ok $timeout, "Timeout wasn't reached";
}
package FO_Test;
sub new
{
bless { val => $_[1] } => __PACKAGE__;
}
sub val
{
return $_[0]{val} if @_ == 1;
return $_[0]{val} = $_[1];
}
package FO_Test2;
sub new
{
bless [ 10, 20, $_[1] ] => __PACKAGE__;
}
sub val
{
return $_[0][2] if @_ == 1;
return $_[0][2] = $_[1];
}
package main;
{
my $cv = condvar AnyEvent;
my $obj = new AnyEvent::ForkObject;
ok $obj, "Constructor";
$obj->do(
module => 'FO_Test',
args => [ 123 ],
cb => sub {
my ($s, $o) = @_;
ok $s eq 'ok', 'FO_Test constructor';
$o->val(sub {
my ($s, $v) = @_;
ok $s eq 'ok' && $v == 123, "FO_Test->val";
$o->val(234, sub {
my ($s, $v) = @_;
ok $s eq 'ok' && $v == 234, "FO_Test->val(234)";
$o->fo_attr(val => sub {
my ($s, $v) = @_;
ok $s eq 'ok' && $v == 234, "FO_Test->fo_attr('val')";
$o->fo_attr(val => 456 => sub {
my ($s, $v) = @_;
( run in 0.666 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )