#!/usr/bin/perl -w # $Id$ # # Test of Error feature use strict; use FindBin; use lib "$FindBin::Bin/.."; use Test::More tests => 22; use POE::Component::Generic; use POE::Session; use POE::Kernel; sub DEBUG () { 0 } my $N = 3; if( $ENV{HARNESS_PERL_SWITCHES} ) { $N *= 5; } my $generic; my $delayed; POE::Session->create( inline_states => { _start => sub { $generic = POE::Component::Generic->spawn( alias => 'first', package => 't::P10', object_options => [ delay=>$N ], verbose => 0, debug => DEBUG, error => 'generic_error' ); $poe_kernel->alias_set( 'worker' ); $poe_kernel->delay( 'autoload', 1 ); }, ############ $generic->method( {} ) autoload => sub { diag( "$N seconds" ); $generic->delay( { event=>'autoload_done', wantarray=>1 } ); $delayed = 1; $poe_kernel->delay( 'autoload_during', 2 ); }, autoload_during => sub { is( $delayed, 1, "Got a POE delay while object was blocking" ); }, autoload_done => sub { my( $input ) = @_[ ARG0, ARG1 ]; my( $before, $after ) = @{ $input->{result} }; $delayed = 0; my $delay = $after - $before; is( $input->{method}, 'delay', "Callback for delay"); is( $input->{wantarray}, 1, "Wantarray preserved"); my $delta = abs( $delay - $N ); ok( ($delta <= 1), "Waited $N seconds") or warn "before=$before after=$after delay=$delay"; $poe_kernel->yield( 'post' ); }, ############ $poe_kernel->post( $generic => 'method', {} ); post => sub { $poe_kernel->post( 'first', set_delay => { event=>'post_set' }, 1 ); }, post_set => sub { $poe_kernel->post( 'first', get_delay => { event=>'post_get' } ); }, post_get => sub { my( $input, $delay ) = @_[ARG0, ARG1]; is( $input->{method}, 'get_delay', "Callback for get_delay"); is( $input->{wantarray}, 0, "Wantarray set"); is_deeply( $input->{result}, [1], "Got current delay" ); is( $delay, 1, "Delay is 1" ); $poe_kernel->post( 'first', delay => { event=>'post_done', wantarray=>1 } ); }, post_done => sub { my( $input ) = $_[ARG0]; my( $before, $after ) = @{ $input->{result} }; my $delay = $after - $before; my $delta = abs( $delay - 1 ); ok( ($delta <= 1), "Waited 1 seconds") or warn "before=$before after=$after delay=$delay"; $poe_kernel->yield( 'call' ); }, ############ $generic->call( 'method', {} ); call => sub { $generic->set_delay( {}, 2*$N ); diag( 2*$N . " seconds" ); $generic->call( delay => { event=>'call_done', wantarray=>1 } ); }, call_done => sub { my( $input, $before, $after ) = @_[ ARG0, ARG1..$#_ ]; my $delay = $after - $before; is( $input->{method}, 'delay', "Callback for delay"); is( $input->{wantarray}, 1, "Wantarray preserved"); is_deeply( $input->{result}, [ $before, $after ], "{result} same as ARG1, ARG2" ); my $delta = abs( $delay - 2*$N ); ok( ($delta <= 1), "Waited ".(2*$N)." seconds") or warn "before=$before after=$after delay=$delay"; $poe_kernel->yield( 'yield' ); }, ############ $generic->yield( 'method', {} ); yield => sub { $generic->yield( get_delay => { event=>'yield_back', wantarray=>0 } ); }, yield_back => sub { my( $input, $delay ) = @_[ARG0, ARG1]; is( $input->{method}, 'get_delay', "Callback for get_delay"); is( $input->{wantarray}, 0, "Wantarray preserved"); is_deeply( $input->{result}, [2*$N], "Got current delay" ); is( $delay, 2*$N, "Delay is ".(2*$N) ); $poe_kernel->yield( 'cause_error' ); }, ############ Test error handling cause_error => sub { $generic->die_for_your_country( {event=>'got_error' }, "VIVA PERON!" ); }, got_error=> sub { my( $resp ) = $_[ARG0]; ok( $resp->{error}, "I want an error" ); ok( ( $resp->{error} =~ /VIVA PERON!/ ), "Right-oh" ); $poe_kernel->yield( 'sing' ); }, ############ Test error handling sing => sub { $generic->sing( { }, "Froggy went a-courtin'" ); $poe_kernel->delay( 'done', 3 ); }, ############ done => sub { $poe_kernel->post( first => 'shutdown' ); $poe_kernel->alias_remove( 'worker' ); }, ############ generic_error => sub { my( $resp ) = $_[ARG0]; ok( $resp->{stderr}, "Only expecting one message on stderr" ); is( $resp->{stderr}, "Froggy went a-courtin'", "And this is it" ); } } ); $poe_kernel->run(); ok( 1, "Sane exit" );