[poe-commits] poe/tests/30_loops/00_base all_errors.pm,1.3,1.4 comp_tcp.pm,1.1,1.2 k_detach.pm,1.2,1
Brought to you by:
rcaputo
Menu
▾
▴
[poe-commits] poe/tests/30_loops/00_base all_errors.pm,1.3,1.4 comp_tcp.pm,1.1,1.2 k_detach.pm,1.2,1.3 k_selects.pm,1.1,1.2 ses_nfa.pm,1.1,1.2 ses_session.pm,1.8,1.9 wheel_accept.pm,1.1,1.2 wheel_sf_ipv6.pm,1.3,1.4 wheel_sf_tcp.pm,1.1,1.2 wheel_sf_udp.pm,1.1,1.2 wheel_sf_unix.pm,1.2,1.3 wheel_tail.pm,1.2,1.3
|
From: <rc...@us...> - 2005-06-28 06:18:30
|
Update of /cvsroot/poe/poe/tests/30_loops/00_base In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15243/tests/30_loops/00_base Modified Files: all_errors.pm comp_tcp.pm k_detach.pm k_selects.pm ses_nfa.pm ses_session.pm wheel_accept.pm wheel_sf_ipv6.pm wheel_sf_tcp.pm wheel_sf_udp.pm wheel_sf_unix.pm wheel_tail.pm Log Message: Deprecate the stinky old TestSetup library in favor of the shiny, and way newer Test::More. This finally resolves rt.cpan.org ticket 7558. Index: all_errors.pm =================================================================== RCS file: /cvsroot/poe/poe/tests/30_loops/00_base/all_errors.pm,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** all_errors.pm 28 Jan 2005 22:55:32 -0000 1.3 --- all_errors.pm 28 Jun 2005 06:18:20 -0000 1.4 *************** *** 7,11 **** use strict; use lib qw(./mylib ../mylib ../lib ./lib); - use TestSetup; sub POE::Kernel::ASSERT_DEFAULT () { 0 } --- 7,10 ---- *************** *** 13,17 **** sub POE::Kernel::TRACE_FILENAME () { "./test-output.err" } ! print "1..0 # skipped: most of these should move into other tests\n"; #use POSIX qw(:errno_h); --- 12,18 ---- sub POE::Kernel::TRACE_FILENAME () { "./test-output.err" } ! # use Test::More; ! ! print "1..0 # most of these should move into other test files\n"; #use POSIX qw(:errno_h); Index: comp_tcp.pm =================================================================== RCS file: /cvsroot/poe/poe/tests/30_loops/00_base/comp_tcp.pm,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** comp_tcp.pm 4 Sep 2004 22:50:39 -0000 1.1 --- comp_tcp.pm 28 Jun 2005 06:18:20 -0000 1.2 *************** *** 6,15 **** use strict; use lib qw(./mylib ../mylib ../lib ./lib); - use TestSetup; ! test_setup(0, "Network access (and permission) required to run this test") ! unless -f 'run_network_tests'; ! test_setup(18); sub POE::Kernel::ASSERT_DEFAULT () { 1 } --- 6,18 ---- use strict; use lib qw(./mylib ../mylib ../lib ./lib); ! BEGIN { ! unless (-f "run_network_tests") { ! print "1..0: Network access (and permission) required to run this test\n"; ! CORE::exit(); ! } ! } ! use Test::More tests => 18; sub POE::Kernel::ASSERT_DEFAULT () { 1 } *************** *** 37,48 **** FlushedEvent => 'got_flush', ); ! ok(1); }, _stop => sub { ! ok(2); }, got_input => sub { my ($heap, $input) = @_[HEAP, ARG0]; ! ok(3); $heap->{wheel}->put("echo: $input"); $heap->{shutdown} = 1 if $input eq "quit"; --- 40,51 ---- FlushedEvent => 'got_flush', ); ! pass("acceptor server got client connection"); }, _stop => sub { ! pass("acceptor server stopped the client session"); }, got_input => sub { my ($heap, $input) = @_[HEAP, ARG0]; ! pass("acceptor server received input"); $heap->{wheel}->put("echo: $input"); $heap->{shutdown} = 1 if $input eq "quit"; *************** *** 50,58 **** got_error => sub { my ($heap, $operation, $errnum, $errstr) = @_[HEAP, ARG0..ARG2]; ! print "server got $operation error $errnum: $errstr\n"; }, got_flush => sub { my $heap = $_[HEAP]; ! ok(4); delete $heap->{wheel} if $heap->{shutdown}; }, --- 53,61 ---- got_error => sub { my ($heap, $operation, $errnum, $errstr) = @_[HEAP, ARG0..ARG2]; ! print "acceptor server got $operation error $errnum: $errstr\n"; }, got_flush => sub { my $heap = $_[HEAP]; ! pass("acceptor server flushed output"); delete $heap->{wheel} if $heap->{shutdown}; }, *************** *** 70,74 **** ClientInput => sub { my ($heap, $input) = @_[HEAP, ARG0]; ! ok(5); $heap->{client}->put("echo: $input"); $heap->{shutdown} = 1 if $input eq "quit"; --- 73,77 ---- ClientInput => sub { my ($heap, $input) = @_[HEAP, ARG0]; ! pass("callback server got input"); $heap->{client}->put("echo: $input"); $heap->{shutdown} = 1 if $input eq "quit"; *************** *** 76,90 **** ClientError => sub { my ($heap, $operation, $errnum, $errstr) = @_[HEAP, ARG0..ARG2]; ! print "server got $operation error $errnum: $errstr\n"; delete $heap->{client}; }, ClientFlushed => sub { ! ok(6); }, ClientConnected => sub { ! ok(7); }, ClientDisconnected => sub { ! ok(8); }, ); --- 79,93 ---- ClientError => sub { my ($heap, $operation, $errnum, $errstr) = @_[HEAP, ARG0..ARG2]; ! print "callback server got $operation error $errnum: $errstr\n"; delete $heap->{client}; }, ClientFlushed => sub { ! pass("callback server flushed output"); }, ClientConnected => sub { ! pass("callback server got client connection"); }, ClientDisconnected => sub { ! pass("callback server got client disconnected"); }, ); *************** *** 97,101 **** Connected => sub { ! ok(9); $_[HEAP]->{server}->put( "quit" ); }, --- 100,104 ---- Connected => sub { ! pass("acceptor client connected"); $_[HEAP]->{server}->put( "quit" ); }, *************** *** 103,111 **** ConnectError => sub { my ($heap, $operation, $errnum, $errstr) = @_[HEAP, ARG0..ARG2]; ! print "server got $operation error $errnum: $errstr\n"; }, Disconnected => sub { ! ok(10); $_[KERNEL]->post( acceptor_server => 'shutdown' ); }, --- 106,114 ---- ConnectError => sub { my ($heap, $operation, $errnum, $errstr) = @_[HEAP, ARG0..ARG2]; ! print "acceptor client got $operation error $errnum: $errstr\n"; }, Disconnected => sub { ! pass("acceptor client disconnected"); $_[KERNEL]->post( acceptor_server => 'shutdown' ); }, *************** *** 113,126 **** ServerInput => sub { my ($heap, $input) = @_[HEAP, ARG0]; ! ok(11); }, ServerError => sub { my ($heap, $operation, $errnum, $errstr) = @_[HEAP, ARG0..ARG2]; ! ok(17) if $operation eq 'read' and $errnum == 0; }, ServerFlushed => sub { ! ok(12); }, ); --- 116,132 ---- ServerInput => sub { my ($heap, $input) = @_[HEAP, ARG0]; ! pass("acceptor client got input"); }, ServerError => sub { my ($heap, $operation, $errnum, $errstr) = @_[HEAP, ARG0..ARG2]; ! ok( ! ($operation eq "read") && ($errnum == 0), ! "acceptor client got read error 0 (EOF)" ! ); }, ServerFlushed => sub { ! pass("acceptor client flushed output"); }, ); *************** *** 133,137 **** Connected => sub { ! ok(13); $_[HEAP]->{server}->put( "quit" ); }, --- 139,143 ---- Connected => sub { ! pass("callback client connected"); $_[HEAP]->{server}->put( "quit" ); }, *************** *** 139,147 **** ConnectError => sub { my ($heap, $operation, $errnum, $errstr) = @_[HEAP, ARG0..ARG2]; ! print "client got $operation error $errnum: $errstr\n"; }, Disconnected => sub { ! ok(14); $_[KERNEL]->post( input_server => 'shutdown' ); }, --- 145,153 ---- ConnectError => sub { my ($heap, $operation, $errnum, $errstr) = @_[HEAP, ARG0..ARG2]; ! print "callback client got $operation error $errnum: $errstr\n"; }, Disconnected => sub { ! pass("callback client disconnected"); $_[KERNEL]->post( input_server => 'shutdown' ); }, *************** *** 149,162 **** ServerInput => sub { my ($heap, $input) = @_[HEAP, ARG0]; ! ok(15); }, ServerError => sub { my ($heap, $operation, $errnum, $errstr) = @_[HEAP, ARG0..ARG2]; ! ok(18) if $operation eq 'read' and $errnum == 0; }, ServerFlushed => sub { ! ok(16); }, ); --- 155,171 ---- ServerInput => sub { my ($heap, $input) = @_[HEAP, ARG0]; ! pass("callback client got input"); }, ServerError => sub { my ($heap, $operation, $errnum, $errstr) = @_[HEAP, ARG0..ARG2]; ! ok( ! ($operation eq "read") && ($errnum == 0), ! "callback client got read error 0 (EOF)" ! ); }, ServerFlushed => sub { ! pass("callback client flushed output"); }, ); *************** *** 164,170 **** # Run the tests. ! $poe_kernel->run(); ! ! results(); 1; --- 173,177 ---- # Run the tests. ! POE::Kernel->run(); 1; Index: k_detach.pm =================================================================== RCS file: /cvsroot/poe/poe/tests/30_loops/00_base/k_detach.pm,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** k_detach.pm 29 Apr 2005 16:42:30 -0000 1.2 --- k_detach.pm 28 Jun 2005 06:18:21 -0000 1.3 *************** *** 6,11 **** use strict; use lib qw(./mylib ../mylib ../lib ./lib); - use TestSetup; - &test_setup(9); # Trace output local to this test program. --- 6,9 ---- *************** *** 16,19 **** --- 14,19 ---- sub POE::Kernel::TRACE_FILENAME () { "./test-output.err" } + use Test::More tests => 9; + use POE; *************** *** 30,72 **** my $grandchild_id = shift; ! POE::Session->create ! ( inline_states => ! { _start => sub { ! my $kernel = $_[KERNEL]; ! $kernel->alias_set( $grandchild_id ); ! DEBUG and warn $_[SESSION]->ID, " has started.\n"; ! }, ! _parent => sub { ! my ($kernel, $old_parent, $new_parent) = @_[KERNEL, ARG0, ARG1]; ! my $old_alias = $kernel->call($old_parent, "get_alias"); ! my $new_alias; ! if (ref($new_parent) eq 'POE::Kernel') { ! $new_alias = 'kernel'; ! } ! else { ! $new_alias = $kernel->call($new_parent, "get_alias"); ! } ! $test_trace .= "(p $grandchild_id $old_alias $new_alias)"; ! }, ! _child => sub { ! my ($kernel, $op, $child) = @_[KERNEL, ARG0, ARG1]; ! my $child_alias = $kernel->call($child, 'get_alias' ); ! $test_trace .= "(c $grandchild_id $op $child_alias)"; ! }, ! get_alias => sub { ! return $grandchild_id; ! }, ! detach_self => sub { ! $_[KERNEL]->detach_myself(); ! }, ! detach_child => sub { ! $_[KERNEL]->detach_child( $_[ARG0] ); ! }, ! _stop => sub { ! my $kernel = $_[KERNEL]; ! DEBUG and warn $_[SESSION]->ID, " stopped.\n"; ! }, }, ! ); # To prevent this from returning a session reference. --- 30,72 ---- my $grandchild_id = shift; ! POE::Session->create( ! inline_states => { ! _start => sub { ! my $kernel = $_[KERNEL]; ! $kernel->alias_set( $grandchild_id ); ! DEBUG and warn $_[SESSION]->ID, " has started.\n"; }, ! _parent => sub { ! my ($kernel, $old_parent, $new_parent) = @_[KERNEL, ARG0, ARG1]; ! my $old_alias = $kernel->call($old_parent, "get_alias"); ! my $new_alias; ! if (ref($new_parent) eq 'POE::Kernel') { ! $new_alias = 'kernel'; ! } ! else { ! $new_alias = $kernel->call($new_parent, "get_alias"); ! } ! $test_trace .= "(p $grandchild_id $old_alias $new_alias)"; ! }, ! _child => sub { ! my ($kernel, $op, $child) = @_[KERNEL, ARG0, ARG1]; ! my $child_alias = $kernel->call($child, 'get_alias' ); ! $test_trace .= "(c $grandchild_id $op $child_alias)"; ! }, ! get_alias => sub { ! return $grandchild_id; ! }, ! detach_self => sub { ! $_[KERNEL]->detach_myself(); ! }, ! detach_child => sub { ! $_[KERNEL]->detach_child( $_[ARG0] ); ! }, ! _stop => sub { ! my $kernel = $_[KERNEL]; ! DEBUG and warn $_[SESSION]->ID, " stopped.\n"; ! }, ! }, ! ); # To prevent this from returning a session reference. *************** *** 80,157 **** my $alias = "a$child_id"; ! POE::Session->create ! ( inline_states => ! { _start => sub { ! my $kernel = $_[KERNEL]; ! $kernel->alias_set( $alias ); ! $kernel->yield( 'spawn_grandchildren' ); ! DEBUG and warn $_[SESSION]->ID, " has started.\n"; ! }, ! spawn_grandchildren => sub { ! &spawn_grandchild( $alias . "_1" ); ! &spawn_grandchild( $alias . "_2" ); ! &spawn_grandchild( $alias . "_3" ); ! }, ! _parent => sub { ! my ($kernel, $old_parent, $new_parent) = @_[KERNEL, ARG0, ARG1]; ! my $old_alias = $kernel->call($old_parent, 'get_alias'); ! my $new_alias; ! if (ref($new_parent) eq 'POE::Kernel') { ! $new_alias = 'kernel'; ! } ! else { ! $new_alias = $kernel->call($new_parent, 'get_alias'); ! } ! $test_trace .= "(p $child_id $old_alias $new_alias)"; ! }, ! _child => sub { ! my ($kernel, $op, $child) = @_[KERNEL, ARG0, ARG1]; ! my $child_alias = $kernel->call($child, 'get_alias' ); ! $test_trace .= "(c $child_id $op $child_alias)"; ! }, ! get_alias => sub { ! return $child_id; ! }, ! detach_self => sub { ! my $kernel = $_[KERNEL]; ! $kernel->detach_myself(); ! }, ! detach_child => sub { ! my $kernel = $_[KERNEL]; ! $kernel->detach_child( $_[ARG0] ); ! }, ! _stop => sub { ! my $kernel = $_[KERNEL]; ! DEBUG and warn $_[SESSION]->ID, " has stopped.\n"; ! }, ! }, ! ); ! ! # To prevent this from returning a session reference. ! undef; ! } ! ! # Spawn the main session. This will spawn children, which will spawn ! # grandchildren. Then the main session will perform controlled ! # detaches and watch the results. ! ! POE::Session->create ! ( inline_states => ! { _start => sub { ! my ($kernel, $heap) = @_[KERNEL, HEAP]; ! $heap->{idle_count} = 0; ! $kernel->alias_set( 'main' ); ! $kernel->yield( 'spawn_children' ); DEBUG and warn $_[SESSION]->ID, " has started.\n"; }, ! spawn_children => sub { ! my $kernel = $_[KERNEL]; ! &spawn_child( 1 ); ! &spawn_child( 2 ); ! &spawn_child( 3 ); ! $kernel->delay( run_tests => 0.5 ); }, get_alias => sub { ! return 'main'; }, detach_self => sub { --- 80,115 ---- my $alias = "a$child_id"; ! POE::Session->create( ! inline_states => { ! _start => sub { ! my $kernel = $_[KERNEL]; ! $kernel->alias_set( $alias ); ! $kernel->yield( 'spawn_grandchildren' ); DEBUG and warn $_[SESSION]->ID, " has started.\n"; }, ! spawn_grandchildren => sub { ! spawn_grandchild( $alias . "_1" ); ! spawn_grandchild( $alias . "_2" ); ! spawn_grandchild( $alias . "_3" ); ! }, ! _parent => sub { ! my ($kernel, $old_parent, $new_parent) = @_[KERNEL, ARG0, ARG1]; ! my $old_alias = $kernel->call($old_parent, 'get_alias'); ! my $new_alias; ! if (ref($new_parent) eq 'POE::Kernel') { ! $new_alias = 'kernel'; ! } ! else { ! $new_alias = $kernel->call($new_parent, 'get_alias'); ! } ! $test_trace .= "(p $child_id $old_alias $new_alias)"; ! }, ! _child => sub { ! my ($kernel, $op, $child) = @_[KERNEL, ARG0, ARG1]; ! my $child_alias = $kernel->call($child, 'get_alias' ); ! $test_trace .= "(c $child_id $op $child_alias)"; }, get_alias => sub { ! return $child_id; }, detach_self => sub { *************** *** 163,239 **** $kernel->detach_child( $_[ARG0] ); }, ! run_tests => sub { ! my ($kernel, $heap) = @_[KERNEL, HEAP]; ! $test_trace = ""; ! $kernel->call( a1_1 => 'detach_self' ); ! ok_if( 1, $test_trace eq '(c 1 lose a1_1)(p a1_1 1 kernel)' ); ! $test_trace = ''; ! $kernel->call( a2_1 => 'detach_self' ); ! ok_if( 2, $test_trace eq '(c 2 lose a2_1)(p a2_1 2 kernel)' ); ! $test_trace = ''; ! $kernel->call( a3_1 => 'detach_self' ); ! ok_if( 3, $test_trace eq '(c 3 lose a3_1)(p a3_1 3 kernel)' ); ! $test_trace = ''; ! $kernel->call( a1 => detach_child => 'a1_2' ); ! ok_if( 4, $test_trace eq '(c 1 lose a1_2)(p a1_2 1 kernel)' ); ! $test_trace = ''; ! $kernel->call( a2 => detach_child => 'a2_2' ); ! ok_if( 5, $test_trace eq '(c 2 lose a2_2)(p a2_2 2 kernel)' ); ! $test_trace = ''; ! $kernel->call( a3 => detach_child => 'a3_2' ); ! ok_if( 6, $test_trace eq '(c 3 lose a3_2)(p a3_2 3 kernel)' ); ! $test_trace = ''; ! $kernel->call( a1 => 'detach_self' ); ! ok_if( 7, $test_trace eq '(c main lose 1)(p 1 main kernel)' ); ! $test_trace = ''; ! $kernel->call( main => detach_child => 'a2' ); ! ok_if( 8, $test_trace eq '(c main lose 2)(p 2 main kernel)' ); ! }, ! _parent => sub { ! my $old_alias = $_[KERNEL]->call( $_[ARG0], 'get_alias' ); ! my $new_alias; ! if (ref($_[ARG1]) eq 'POE::Kernel') { ! $new_alias = 'kernel'; ! } ! else { ! $new_alias = $_[KERNEL]->call( $_[ARG1], 'get_alias' ); ! } ! $test_trace .= "(p main $old_alias $new_alias)"; ! }, ! _child => sub { ! my $child_alias = $_[KERNEL]->call( $_[ARG1], 'get_alias' ); ! $test_trace .= "(c main $_[ARG0] $child_alias)"; ! }, ! _stop => sub { ! DEBUG and warn $_[SESSION]->ID, " has stopped.\n"; ! }, ! grandchild_parent => sub { ! my $old_alias = $_[KERNEL]->call( $_[ARG1], 'get_alias' ); ! my $new_alias; ! if (ref($_[ARG2]) eq 'POE::Kernel') { ! $new_alias = 'kernel'; ! } ! else { ! $new_alias = $_[KERNEL]->call( $_[ARG2], 'get_alias' ); ! } ! $test_trace .= "(p $_[ARG0] $old_alias $new_alias)"; ! }, ! grandchild_child => sub { ! my $child_alias = $_[KERNEL]->call( $_[ARG2], 'get_alias' ); ! $test_trace .= "(c $_[ARG0] $_[ARG1] $child_alias)"; ! }, }, ! ); ! $poe_kernel->run(); # Final test to see if the remaining sessions died properly. The --- 121,263 ---- $kernel->detach_child( $_[ARG0] ); }, ! _stop => sub { ! my $kernel = $_[KERNEL]; ! DEBUG and warn $_[SESSION]->ID, " has stopped.\n"; ! }, ! }, ! ); ! # To prevent this from returning a session reference. ! undef; ! } ! # Spawn the main session. This will spawn children, which will spawn ! # grandchildren. Then the main session will perform controlled ! # detaches and watch the results. ! POE::Session->create( ! inline_states => { ! _start => sub { ! my ($kernel, $heap) = @_[KERNEL, HEAP]; ! $heap->{idle_count} = 0; ! $kernel->alias_set( 'main' ); ! $kernel->yield( 'spawn_children' ); ! DEBUG and warn $_[SESSION]->ID, " has started.\n"; ! }, ! spawn_children => sub { ! my $kernel = $_[KERNEL]; ! spawn_child( 1 ); ! spawn_child( 2 ); ! spawn_child( 3 ); ! $kernel->delay( run_tests => 0.5 ); ! }, ! get_alias => sub { ! return 'main'; ! }, ! detach_self => sub { ! my $kernel = $_[KERNEL]; ! $kernel->detach_myself(); ! }, ! detach_child => sub { ! my $kernel = $_[KERNEL]; ! $kernel->detach_child( $_[ARG0] ); ! }, ! run_tests => sub { ! my ($kernel, $heap) = @_[KERNEL, HEAP]; ! $test_trace = ""; ! $kernel->call( a1_1 => 'detach_self' ); ! ok( ! $test_trace eq '(c 1 lose a1_1)(p a1_1 1 kernel)', ! "a1_1 detached itself" ! ); ! $test_trace = ''; ! $kernel->call( a2_1 => 'detach_self' ); ! ok( ! $test_trace eq '(c 2 lose a2_1)(p a2_1 2 kernel)', ! "a2_1 detached itself" ! ); ! $test_trace = ''; ! $kernel->call( a3_1 => 'detach_self' ); ! ok( ! $test_trace eq '(c 3 lose a3_1)(p a3_1 3 kernel)', ! "a3_1 detached itself" ! ); ! $test_trace = ''; ! $kernel->call( a1 => detach_child => 'a1_2' ); ! ok( ! $test_trace eq '(c 1 lose a1_2)(p a1_2 1 kernel)', ! "a1 detached child a1_2" ! ); ! $test_trace = ''; ! $kernel->call( a2 => detach_child => 'a2_2' ); ! ok( ! $test_trace eq '(c 2 lose a2_2)(p a2_2 2 kernel)', ! "a2 detached child a2_2" ! ); ! $test_trace = ''; ! $kernel->call( a3 => detach_child => 'a3_2' ); ! ok( ! $test_trace eq '(c 3 lose a3_2)(p a3_2 3 kernel)', ! "a3 detached child a3_2" ! ); ! ! $test_trace = ''; ! $kernel->call( a1 => 'detach_self' ); ! ok( ! $test_trace eq '(c main lose 1)(p 1 main kernel)', ! "a1 detached itself" ! ); ! ! $test_trace = ''; ! $kernel->call( main => detach_child => 'a2' ); ! ok( ! $test_trace eq '(c main lose 2)(p 2 main kernel)', ! "a2 detached itself" ! ); }, ! _parent => sub { ! my $old_alias = $_[KERNEL]->call( $_[ARG0], 'get_alias' ); ! my $new_alias; ! if (ref($_[ARG1]) eq 'POE::Kernel') { ! $new_alias = 'kernel'; ! } ! else { ! $new_alias = $_[KERNEL]->call( $_[ARG1], 'get_alias' ); ! } ! $test_trace .= "(p main $old_alias $new_alias)"; ! }, ! _child => sub { ! my $child_alias = $_[KERNEL]->call( $_[ARG1], 'get_alias' ); ! $test_trace .= "(c main $_[ARG0] $child_alias)"; ! }, ! _stop => sub { ! DEBUG and warn $_[SESSION]->ID, " has stopped.\n"; ! }, ! grandchild_parent => sub { ! my $old_alias = $_[KERNEL]->call( $_[ARG1], 'get_alias' ); ! my $new_alias; ! if (ref($_[ARG2]) eq 'POE::Kernel') { ! $new_alias = 'kernel'; ! } ! else { ! $new_alias = $_[KERNEL]->call( $_[ARG2], 'get_alias' ); ! } ! $test_trace .= "(p $_[ARG0] $old_alias $new_alias)"; ! }, ! grandchild_child => sub { ! my $child_alias = $_[KERNEL]->call( $_[ARG2], 'get_alias' ); ! $test_trace .= "(c $_[ARG0] $_[ARG1] $child_alias)"; ! }, ! }, ! ); ! ! POE::Kernel->run(); # Final test to see if the remaining sessions died properly. The *************** *** 245,261 **** $test_trace = '(' . (join ')(', sort split /\)\(/, $test_trace) . ')'; ! ok_if( 9, ! $test_trace eq ! join( "", ! "(c 1 lose a1_3)", ! "(c 2 lose a2_3)", ! "(c 3 lose a3_3)", ! "(c main lose 2)", ! "(c main lose 3)", ! "(p 2 main kernel)" ! ) ! ); ! ! &results; 1; --- 269,284 ---- $test_trace = '(' . (join ')(', sort split /\)\(/, $test_trace) . ')'; ! ok( ! $test_trace eq join( ! "", ! "(c 1 lose a1_3)", ! "(c 2 lose a2_3)", ! "(c 3 lose a3_3)", ! "(c main lose 2)", ! "(c main lose 3)", ! "(p 2 main kernel)" ! ), ! "session destruction order" ! ); 1; Index: k_selects.pm =================================================================== RCS file: /cvsroot/poe/poe/tests/30_loops/00_base/k_selects.pm,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** k_selects.pm 4 Sep 2004 22:50:39 -0000 1.1 --- k_selects.pm 28 Jun 2005 06:18:21 -0000 1.2 *************** *** 7,11 **** use lib qw(./mylib ../mylib ../lib ./lib); - use TestSetup; sub POE::Kernel::ASSERT_DEFAULT () { 1 } --- 7,10 ---- *************** *** 13,17 **** sub POE::Kernel::TRACE_FILENAME () { "./test-output.err" } ! test_setup(16); use POE qw(Pipe::OneWay Pipe::TwoWay); --- 12,16 ---- sub POE::Kernel::TRACE_FILENAME () { "./test-output.err" } ! use Test::More tests => 17; use POE qw(Pipe::OneWay Pipe::TwoWay); *************** *** 22,29 **** my $chat_count = 5; - ### Register for individual test results. - - my @test_results; - # What to do here? Create ten master sessions that create socket # pairs. Each master session spawns a slave session and gives it the --- 21,24 ---- *************** *** 38,52 **** sub master_start { ! my ($kernel, $heap, $test_index) = @_[KERNEL, HEAP, ARG0]; ! ! $test_index *= 2; my ($master_read, $master_write, $slave_read, $slave_write) = POE::Pipe::TwoWay->new(); ! unless (defined $master_read) { ! $test_results[$test_index] = $test_results[$test_index + 1] = undef; ! return; ! } # Listen on the uplink_read side. --- 33,42 ---- sub master_start { ! my ($kernel, $heap ) = @_[KERNEL, HEAP, ARG0]; my ($master_read, $master_write, $slave_read, $slave_write) = POE::Pipe::TwoWay->new(); ! ok( defined($master_read), "master: created two-way pipe for testing" ); # Listen on the uplink_read side. *************** *** 54,71 **** # Give the other side to a newly spawned session. ! POE::Session->create ! ( inline_states => ! { _start => \&slave_start, ! _stop => \&slave_stop, ! input => \&slave_got_input, ! resume => \&slave_resume_read, ! output => \&slave_put_output, ! }, ! args => [ $slave_read, $slave_write, $test_index + 1 ], ! ); # Save some values for later. $heap->{write} = $master_write; - $heap->{test_index} = $test_index; $heap->{test_count} = 0; $heap->{queue} = [ ]; --- 44,60 ---- # Give the other side to a newly spawned session. ! POE::Session->create( ! inline_states => { ! _start => \&slave_start, ! _stop => \&slave_stop, ! input => \&slave_got_input, ! resume => \&slave_resume_read, ! output => \&slave_put_output, ! }, ! args => [ $slave_read, $slave_write ], ! ); # Save some values for later. $heap->{write} = $master_write; $heap->{test_count} = 0; $heap->{queue} = [ ]; *************** *** 79,83 **** # Determine if we were successful. ! $test_results[$heap->{test_index}] = ($heap->{test_count} == $chat_count); } --- 68,75 ---- # Determine if we were successful. ! ok( ! $heap->{test_count} == $chat_count, ! "master: expected number of messages" ! ); } *************** *** 113,118 **** if (@{$heap->{queue}}) { my $message = shift @{$heap->{queue}}; ! die $! ! unless syswrite($handle, $message, length($message)) == length($message); } --- 105,111 ---- if (@{$heap->{queue}}) { my $message = shift @{$heap->{queue}}; ! die $! unless ( ! syswrite($handle, $message, length($message)) == length($message) ! ); } *************** *** 147,151 **** # Determine if we were successful. ! $test_results[$heap->{test_index}] = ($heap->{test_count} == $chat_count); } --- 140,147 ---- # Determine if we were successful. ! ok( ! $heap->{test_count} == $chat_count, ! "slave: expected number of messages" ! ); } *************** *** 196,201 **** if (@{$heap->{queue}}) { my $message = shift @{$heap->{queue}}; ! die $! ! unless syswrite($handle, $message, length($message)) == length($message); # Kludge. We requested quit, so go ahead and quit. --- 192,198 ---- if (@{$heap->{queue}}) { my $message = shift @{$heap->{queue}}; ! die $! unless ( ! syswrite($handle, $message, length($message)) == length($message) ! ); # Kludge. We requested quit, so go ahead and quit. *************** *** 211,229 **** ### Main loop. - print "ok 1\n"; - # Spawn a group of master sessions. for (my $index = 0; $index < $pair_count; $index++) { ! POE::Session->create ! ( inline_states => ! { _start => \&master_start, ! _stop => \&master_stop, ! _child => sub { }, ! input => \&master_got_input, ! output => \&master_put_output, ! }, ! args => [ $index ], ! ); } --- 208,224 ---- ### Main loop. # Spawn a group of master sessions. for (my $index = 0; $index < $pair_count; $index++) { ! POE::Session->create( ! inline_states => { ! _start => \&master_start, ! _stop => \&master_stop, ! _child => sub { }, ! input => \&master_got_input, ! output => \&master_put_output, ! }, ! args => [ $index ], ! ); } *************** *** 231,293 **** # _internal_select. ! POE::Session->create ! ( inline_states => ! { _start => sub { ! ! my $conduit; ! $conduit = "inet" if $^O eq "MSWin32"; ! my ($r, $w) = POE::Pipe::OneWay->new($conduit); ! my $kernel = $_[KERNEL]; ! $kernel->select_read($r, "input"); ! $kernel->select_write($r, "output"); ! $kernel->select_write($r); ! $kernel->select_write($r, "output"); ! $kernel->select($r); ! print "ok 2\n"; ! }, ! _stop => sub { }, }, ! ); ! ! print "ok 3\n"; # Now run them until they're done. ! $poe_kernel->run(); ! ! # Now make sure they've run. ! for (my $index = 0; $index < $pair_count << 1; $index++) { ! print "not " unless $test_results[$index]; ! print "ok ", $index + 4, "\n"; ! } ! ! print "ok 14\n"; # Try a re-entrant version. ! POE::Session->create ! ( inline_states => ! { _start => sub { ! $_[HEAP]->{count} = 0; ! $_[KERNEL]->yield("increment"); ! }, ! increment => sub { ! my ($kernel, $heap) = @_[KERNEL, HEAP]; ! if ($heap->{count} < 10) { ! $kernel->yield("increment"); ! $heap->{count}++; ! } ! }, ! _stop => sub { ! print "not " unless $_[HEAP]->{count} == 10; ! print "ok 15\n"; ! }, ! } ! ); # Verify that the main loop can run yet again. ! $poe_kernel->run(); ! print "ok 16\n"; 1; --- 226,275 ---- # _internal_select. ! POE::Session->create( ! inline_states => { ! _start => sub { ! my $conduit; ! $conduit = "inet" if $^O eq "MSWin32"; ! my ($r, $w) = POE::Pipe::OneWay->new($conduit); ! my $kernel = $_[KERNEL]; ! $kernel->select_read($r, "input"); ! $kernel->select_write($r, "output"); ! $kernel->select_write($r); ! $kernel->select_write($r, "output"); ! $kernel->select($r); }, ! _stop => sub { }, ! }, ! ); # Now run them until they're done. ! POE::Kernel->run(); # Try a re-entrant version. ! POE::Session->create( ! inline_states => { ! _start => sub { ! $_[HEAP]->{count} = 0; ! $_[KERNEL]->yield("increment"); ! }, ! increment => sub { ! my ($kernel, $heap) = @_[KERNEL, HEAP]; ! if ($heap->{count} < 10) { ! $kernel->yield("increment"); ! $heap->{count}++; ! } ! }, ! _stop => sub { ! ok( $_[HEAP]->{count} == 10, "re-entered event loop ran" ); ! }, ! } ! ); # Verify that the main loop can run yet again. ! POE::Kernel->run(); ! pass("second event loop run exited normally"); 1; Index: ses_nfa.pm =================================================================== RCS file: /cvsroot/poe/poe/tests/30_loops/00_base/ses_nfa.pm,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** ses_nfa.pm 4 Sep 2004 22:50:39 -0000 1.1 --- ses_nfa.pm 28 Jun 2005 06:18:21 -0000 1.2 *************** *** 6,11 **** use strict; use lib qw(./mylib ../mylib ../lib ./lib); - use TestSetup; - &test_setup(20); sub POE::Kernel::ASSERT_DEFAULT () { 1 } --- 6,9 ---- *************** *** 13,16 **** --- 11,16 ---- sub POE::Kernel::TRACE_FILENAME () { "./test-output.err" } + use Test::More tests => 20; + use POE qw(NFA); *************** *** 22,61 **** use POE::NFA; ! POE::NFA->spawn ! ( inline_states => ! { ! # The initial state, and its start event. Make the switch ! # visible by name, and start in the 'off' state. ! initial => ! { start => sub { $_[KERNEL]->alias_set( 'switch' ); ! $_[MACHINE]->goto_state( 'off' ); ! }, ! _default => sub { 0 }, }, ! # The light is off. When this state is entered, post a ! # visibility event at whatever had caused the light to go off. ! # When it's pushed, have the light go on. ! off => ! { enter => sub { ! $_[KERNEL]->post( $_[ARG0] => visibility => 0 ); ! }, ! pushed => sub { $_[MACHINE]->goto_state( on => enter => $_[SENDER] ); ! }, ! _default => sub { 0 }, }, ! # The light is on. When this state is entered, post a visibility ! # event at whatever had caused the light to go on. When it's ! # pushed, have the light go off. ! on => ! { enter => sub { ! $_[KERNEL]->post( $_[ARG0] => visibility => 1 ); ! }, ! pushed => sub { ! $_[MACHINE]->goto_state( off => enter => $_[SENDER] ); ! }, ! _default => sub { 0 }, }, ! }, ! )->goto_state( initial => 'start' ); # enter the initial state ### This NFA uses the stop() method. Gabriel Kihlman discovered that --- 22,62 ---- use POE::NFA; ! POE::NFA->spawn( ! inline_states => { ! # The initial state, and its start event. Make the switch ! # visible by name, and start in the 'off' state. ! initial => { ! start => sub { ! $_[KERNEL]->alias_set( 'switch' ); ! $_[MACHINE]->goto_state( 'off' ); }, ! _default => sub { 0 }, ! }, ! # The light is off. When this state is entered, post a ! # visibility event at whatever had caused the light to go off. ! # When it's pushed, have the light go on. ! off => { ! enter => sub { ! $_[KERNEL]->post( $_[ARG0] => visibility => 0 ); }, ! pushed => sub { ! $_[MACHINE]->goto_state( on => enter => $_[SENDER] ); }, ! _default => sub { 0 }, ! }, ! # The light is on. When this state is entered, post a visibility ! # event at whatever had caused the light to go on. When it's ! # pushed, have the light go off. ! on => { ! enter => sub { ! $_[KERNEL]->post( $_[ARG0] => visibility => 1 ); ! }, ! pushed => sub { ! $_[MACHINE]->goto_state( off => enter => $_[SENDER] ); ! }, ! _default => sub { 0 }, ! }, ! }, ! )->goto_state( initial => 'start' ); # enter the initial state ### This NFA uses the stop() method. Gabriel Kihlman discovered that *************** *** 63,73 **** ### fixed to use the new _data_ses_free() method of POE::Kernel. ! POE::NFA->spawn ! ( inline_states => ! { initial => ! { start => sub { $_[MACHINE]->stop() } ! } } ! )->goto_state(initial => 'start'); ### A plain session to interact with the switch. It's in its own --- 64,74 ---- ### fixed to use the new _data_ses_free() method of POE::Kernel. ! POE::NFA->spawn( ! inline_states => { ! initial => { ! start => sub { $_[MACHINE]->stop() } } ! } ! )->goto_state(initial => 'start'); ### A plain session to interact with the switch. It's in its own *************** *** 78,112 **** package Operator; use POE::Session; - use TestSetup; ! POE::Session->create ! ( inline_states => ! { ! # Start by giving the session a name. This keeps the session ! # alive while other sessions (the light) operate. Set a test ! # counter, and yield to the 'push' handler. ! _start => sub { ! $_[KERNEL]->alias_set( 'operator' ); ! $_[KERNEL]->yield( 'push' ); ! $_[HEAP]->{push_count} = 0; ! }, ! # Push the button, and count the button push for testing. ! push => sub { ! $_[HEAP]->{push_count}++; ! $_[KERNEL]->post( switch => 'pushed' ); ! }, ! # The light did something observable. Check that its on/off ! # state matches our expectation. If we need to test some more, ! # push the button again. ! visibility => sub { ! &ok_if( $_[HEAP]->{push_count}, ! ($_[HEAP]->{push_count} & 1) == $_[ARG0] ! ); ! $_[KERNEL]->yield( 'push' ) if $_[HEAP]->{push_count} < 10; ! }, ! # Dummy handlers to avoid ASSERT_STATES warnings. ! _stop => sub { 0 }, ! } ! ); ### This is a Fibonacci number servlet. Post it a request with the F --- 79,112 ---- package Operator; use POE::Session; ! POE::Session->create( ! inline_states => { ! # Start by giving the session a name. This keeps the session ! # alive while other sessions (the light) operate. Set a test ! # counter, and yield to the 'push' handler. ! _start => sub { ! $_[KERNEL]->alias_set( 'operator' ); ! $_[KERNEL]->yield( 'push' ); ! $_[HEAP]->{push_count} = 0; ! }, ! # Push the button, and count the button push for testing. ! push => sub { ! $_[HEAP]->{push_count}++; ! $_[KERNEL]->post( switch => 'pushed' ); ! }, ! # The light did something observable. Check that its on/off ! # state matches our expectation. If we need to test some more, ! # push the button again. ! visibility => sub { ! Test::More::ok( ! ($_[HEAP]->{push_count} & 1) == $_[ARG0], ! "light state matches expected state" ! ); ! $_[KERNEL]->yield( 'push' ) if $_[HEAP]->{push_count} < 10; ! }, ! # Dummy handlers to avoid ASSERT_STATES warnings. ! _stop => sub { 0 }, ! } ! ); ### This is a Fibonacci number servlet. Post it a request with the F *************** *** 116,170 **** use POE::NFA; ! POE::NFA->spawn ! ( inline_states => ! { ! # Set up an alias so that clients can find us. ! initial => ! { start => sub { $_[KERNEL]->alias_set( 'server' ); ! $_[MACHINE]->goto_state( 'listen' ); ! }, ! _default => sub { 0 }, }, ! # Listen for a request. The request includes which Fibonacci ! # number to return. ! listen => ! { request => sub { ! $_[RUNSTATE]->{client} = $_[SENDER]; ! $_[MACHINE]->call_state( answer => # return event ! calculate => # new state ! start => # new state's entry event ! $_[ARG0] # F-number to return ! ); ! }, ! answer => sub { ! $_[KERNEL]->post( delete($_[RUNSTATE]->{client}), 'fib', $_[ARG0] ); ! }, ! _default => sub { 0 }, }, ! calculate => ! { start => sub { ! $_[MACHINE]->return_state( 0 ) if $_[ARG0] == 0; ! $_[MACHINE]->return_state( 1 ) if $_[ARG0] == 1; ! $_[RUNSTATE]->{f} = [ 0, 1 ]; ! $_[RUNSTATE]->{n} = 1; ! $_[RUNSTATE]->{target} = $_[ARG0]; $_[KERNEL]->yield( 'next' ); ! }, ! next => sub { ! $_[RUNSTATE]->{n}++; ! $_[RUNSTATE]->{f}->[2] = ! $_[RUNSTATE]->{f}->[0] + $_[RUNSTATE]->{f}->[1]; ! shift @{$_[RUNSTATE]->{f}}; ! if ($_[RUNSTATE]->{n} == $_[RUNSTATE]->{target}) { ! $_[MACHINE]->return_state( $_[RUNSTATE]->{f}->[1] ); ! } ! else { ! $_[KERNEL]->yield( 'next' ); ! } ! }, ! _default => sub { 0 }, }, ! } ! )->goto_state( initial => 'start' ); ### This is a Fibonacci client. It asks for F numbers and checks the --- 116,169 ---- use POE::NFA; ! POE::NFA->spawn( ! inline_states => { ! # Set up an alias so that clients can find us. ! initial => ! { start => sub { $_[KERNEL]->alias_set( 'server' ); ! $_[MACHINE]->goto_state( 'listen' ); ! }, ! _default => sub { 0 }, ! }, ! # Listen for a request. The request includes which Fibonacci ! # number to return. ! listen => ! { request => sub { ! $_[RUNSTATE]->{client} = $_[SENDER]; ! $_[MACHINE]->call_state( answer => # return event ! calculate => # new state ! start => # new state's entry event ! $_[ARG0] # F-number to return ! ); }, ! answer => sub { ! $_[KERNEL]->post( delete($_[RUNSTATE]->{client}), 'fib', $_[ARG0] ); }, ! _default => sub { 0 }, ! }, ! calculate => ! { start => sub { ! $_[MACHINE]->return_state( 0 ) if $_[ARG0] == 0; ! $_[MACHINE]->return_state( 1 ) if $_[ARG0] == 1; ! $_[RUNSTATE]->{f} = [ 0, 1 ]; ! $_[RUNSTATE]->{n} = 1; ! $_[RUNSTATE]->{target} = $_[ARG0]; ! $_[KERNEL]->yield( 'next' ); ! }, ! next => sub { ! $_[RUNSTATE]->{n}++; ! $_[RUNSTATE]->{f}->[2] = ! $_[RUNSTATE]->{f}->[0] + $_[RUNSTATE]->{f}->[1]; ! shift @{$_[RUNSTATE]->{f}}; ! if ($_[RUNSTATE]->{n} == $_[RUNSTATE]->{target}) { ! $_[MACHINE]->return_state( $_[RUNSTATE]->{f}->[1] ); ! } ! else { $_[KERNEL]->yield( 'next' ); ! } }, ! _default => sub { 0 }, ! }, ! } ! )->goto_state( initial => 'start' ); ### This is a Fibonacci client. It asks for F numbers and checks the *************** *** 172,224 **** package Client; - use TestSetup; use POE::Session; my $test_number = 11; ! my @test = ! ( [ 0, 0 ], ! [ 1, 1 ], ! [ 2, 1 ], ! [ 3, 2 ], ! [ 4, 3 ], ! [ 5, 5 ], ! ! [ 17, 1597 ], ! [ 23, 28657 ], ! [ 29, 514229 ], ! [ 43, 433494437 ], ! ); ! POE::Session->create ! ( inline_states => ! { _start => sub { ! # Set up an alias so we'll stay alive until everything is done. ! $_[KERNEL]->alias_set( 'client' ); ! $_[KERNEL]->yield( 'next_test' ); ! }, ! next_test => sub { ! $_[KERNEL]->post( server => request => $test[0]->[0] ); ! }, ! fib => sub { ! &ok_if( $test_number, $_[ARG0] == $test[0]->[1], ! "fib($test[0]->[0]) returned $_[ARG0] (wanted $test[0]->[1])" ! ); ! shift @test; ! $test_number++; ! $_[KERNEL]->yield( 'next_test' ) if @test; ! }, ! # Dummy handlers to avoid ASSERT_STATES warnings. ! _stop => sub { 0 }, }, ! ); ! ### Run everything until it's all done. Display test results when ! ### everything is done, and exit. Success! package main; ! $poe_kernel->run(); ! &results(); 1; --- 171,220 ---- package Client; use POE::Session; my $test_number = 11; ! my @test = ( ! [ 0, 0 ], ! [ 1, 1 ], ! [ 2, 1 ], ! [ 3, 2 ], ! [ 4, 3 ], ! [ 5, 5 ], ! [ 17, 1597 ], ! [ 23, 28657 ], ! [ 29, 514229 ], ! [ 43, 433494437 ], ! ); ! POE::Session->create( ! inline_states => { ! _start => sub { ! # Set up an alias so we'll stay alive until everything is done. ! $_[KERNEL]->alias_set( 'client' ); ! $_[KERNEL]->yield( 'next_test' ); }, ! next_test => sub { ! $_[KERNEL]->post( server => request => $test[0]->[0] ); ! }, ! fib => sub { ! Test::More::ok( ! $_[ARG0] == $test[0]->[1], ! "fib($test[0]->[0]) returned $_[ARG0] (wanted $test[0]->[1])" ! ); ! shift @test; ! $test_number++; ! $_[KERNEL]->yield( 'next_test' ) if @test; ! }, ! # Dummy handlers to avoid ASSERT_STATES warnings. ! _stop => sub { 0 }, ! }, ! ); ! ### Run everything until it's all done. package main; ! POE::Kernel->run(); 1; Index: ses_session.pm =================================================================== RCS file: /cvsroot/poe/poe/tests/30_loops/00_base/ses_session.pm,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** ses_session.pm 28 Jan 2005 22:55:33 -0000 1.8 --- ses_session.pm 28 Jun 2005 06:18:21 -0000 1.9 *************** *** 7,11 **** use lib qw(./mylib ../mylib ../lib ./lib); - use TestSetup; BEGIN { --- 7,10 ---- *************** *** 15,20 **** } ! test_setup(39); ! use POE; --- 14,18 ---- } ! use Test::More tests => 38; use POE; *************** *** 28,35 **** my $got_heap_count = 0; my $default_count = 0; - my $get_active_session_within = 0; - my $get_active_session_before = 0; - my $get_active_session_after = 0; - my $get_active_session_heap = 0; die "machine count must be even" if $machine_count & 1; --- 26,29 ---- *************** *** 209,217 **** }, _stop => sub { ! $get_active_session_within = ( ! $_[KERNEL]->get_active_session() == $_[SESSION] ); ! $get_active_session_heap = ( ! $_[KERNEL]->get_active_session()->get_heap() == $_[HEAP] ); }, --- 203,213 ---- }, _stop => sub { ! ok( ! $_[KERNEL]->get_active_session() == $_[SESSION], ! "get_active_session within session" ); ! ok( ! $_[KERNEL]->get_active_session()->get_heap() == $_[HEAP], ! "get_heap during stop" ); }, *************** *** 357,363 **** # Main loop. ! $get_active_session_before = $poe_kernel->get_active_session() == $poe_kernel; POE::Kernel->run(); ! $get_active_session_after = $poe_kernel->get_active_session() == $poe_kernel; #------------------------------------------------------------------------------ --- 353,367 ---- # Main loop. ! ok( ! $poe_kernel->get_active_session() == $poe_kernel, ! "get_active_session before POE::Kernel->run()" ! ); ! POE::Kernel->run(); ! ! ok( ! $poe_kernel->get_active_session() == $poe_kernel, ! "get_active_session after POE::Kernel->run()" ! ); #------------------------------------------------------------------------------ *************** *** 366,428 **** # Now make sure they've run. for (my $i=0; $i<$machine_count; $i++) { ! print 'not ' unless $completions[$i] == $event_count; ! print 'ok ', $i+1, "\n"; } # Were all the signals caught? ! if ($^O eq 'MSWin32' or $^O eq 'MacOS') { ! print "ok 11 # skipped: $^O does not support signals.\n"; ! print "ok 12 # skipped: $^O does not support signals.\n"; ! } ! else { ! print 'not ' unless $sigalrm_caught == $event_count; ! print "ok 11\n"; ! print 'not ' unless $sigpipe_caught == $event_count; ! print "ok 12\n"; } # Did the postbacks work? ! print 'not ' unless $postback_test; ! print "ok 13\n"; ! ! print 'not ' unless $callback_test; ! print "ok 14\n"; ! ! # Were the various get_active_session() calls correct? ! print 'not ' unless $get_active_session_within; ! print "ok 15\n"; ! ! print 'not ' unless $get_active_session_before; ! print "ok 16\n"; ! ! print 'not ' unless $get_active_session_after; ! print "ok 17\n"; ! ! # Was the get_heap() call correct? ! print 'not ' unless $get_active_session_heap; ! print "ok 18\n"; # Gratuitous tests to appease the coverage gods. ! print 'not ' unless ( ! ARG1 == ARG0+1 and ARG2 == ARG1+1 and ARG3 == ARG2+1 and ! ARG4 == ARG3+1 and ARG5 == ARG4+1 and ARG6 == ARG5+1 and ! ARG7 == ARG6+1 and ARG8 == ARG7+1 and ARG9 == ARG8+1 ); - print "ok 19\n"; ! print 'not ' unless $sender_count == $machine_count * $event_count; ! print "ok 20\n"; ! print 'not ' unless $default_count == ($machine_count * $event_count); ! print "ok 21\n"; ! print 'not ' unless $got_heap_count == $machine_count; ! print "ok 22\n"; # Object/package sessions. for (0..3) { ! print 'not ' unless $objpack[$_] == $event_count; ! print 'ok ', $_ + 23, "\n"; } --- 370,429 ---- # Now make sure they've run. for (my $i=0; $i<$machine_count; $i++) { ! ok( ! $completions[$i] == $event_count, ! "test $i ran" ! ); } # Were all the signals caught? ! SKIP: { ! if ($^O eq "MSWin32" or $^O eq "MacOS") { ! skip "$^O does not support signals", 2; ! } ! ok( ! $sigalrm_caught == $event_count, ! "caught enough SIGALRMs" ! ); ! ! ok( ! $sigpipe_caught == $event_count, ! "caught enough SIGPIPEs" ! ); } # Did the postbacks work? ! ok( $postback_test, "postback test" ); ! ok( $callback_test, "callback test" ); # Gratuitous tests to appease the coverage gods. ! ok( ! (ARG1 == ARG0+1) && (ARG2 == ARG1+1) && (ARG3 == ARG2+1) && ! (ARG4 == ARG3+1) && (ARG5 == ARG4+1) && (ARG6 == ARG5+1) && ! (ARG7 == ARG6+1) && (ARG8 == ARG7+1) && (ARG9 == ARG8+1), ! "ARG constants are good" ); ! ok( ! $sender_count == $machine_count * $event_count, ! "sender_count" ! ); ! ok( ! $default_count == $machine_count * $event_count, ! "default_count" ! ); ! ok( ! $got_heap_count == $machine_count, ! "got_heap_count" ! ); # Object/package sessions. for (0..3) { ! ok( ! $objpack[$_] == $event_count, ! "object/package session $_ event count" ! ); } *************** *** 526,533 **** my $expected; if ($] >= 5.004 and $] < 5.005) { ! warn( ! "# Note: Perl 5.004-ish appears to leak sessions.\n", ! "# Consider upgrading to Perl 5.005_04 or beyond.\n", ! ); $expected = 0; } --- 527,533 ---- my $expected; if ($] >= 5.004 and $] < 5.005) { ! diag( "Note: We find your choice of Perl versions disturbing" ); ! diag( "primarily due to the number of bugs POE triggers within" ); ! diag( "it. You should seriously consider upgrading." ); $expected = 0; } *************** *** 536,572 **** } ! print 'not ' unless $sessions_destroyed == $expected; ! print "ok 27 # dest $sessions_destroyed sessions (expected $expected)\n"; # 5.004 and 5.005 have some nasty gc issues. Near as I can tell, # data inside the heap is surviving the session DESTROY. This # isnt possible in a sane and normal world. So if this is giving ! # you fits, please consider upgrading perl to at least 5.6.1. my $expected; ! if($] >= 5.006 or ($] >= 5.004 and $] < 5.005)) { $expected = 3; } else { $expected = 2; } ! print 'not ' unless $objects_destroyed == $expected; ! print "ok 28 # dest $objects_destroyed objects (expected $expected)\n"; } } ); ! $poe_kernel->run; ! print 'not ' unless $stop_called == 0; ! print "ok 29\n"; ! print 'not ' unless $child_called == 0; ! print "ok 30\n"; ! print 'not ' unless $parent_called == 0; ! print "ok 31\n"; my $expected; if ($] >= 5.004 and $] < 5.005) { ! warn( ! "# Note: Perl 5.004-ish appears to leak sessions.\n", ! "# Consider upgrading to Perl 5.005_04 or beyond.\n", ! ); $expected = 0; } --- 536,586 ---- } ! ok( ! $sessions_destroyed == $expected, ! "$sessions_destroyed sessions destroyed (expected $expected)" ! ); # 5.004 and 5.005 have some nasty gc issues. Near as I can tell, # data inside the heap is surviving the session DESTROY. This # isnt possible in a sane and normal world. So if this is giving ! # you fits, consider it a sign that your "legacy perl" fetish is ! # bizarre and harmful. my $expected; ! if ($] >= 5.006 or ($] >= 5.004 and $] < 5.005)) { $expected = 3; } else { $expected = 2; + diag( "Your version of Perl is rather buggy. Consider upgrading." ); } ! ! ok( ! $objects_destroyed == $expected, ! "$objects_destroyed objects destroyed (expected $expected)" ! ); } } ); ! POE::Kernel->run(); ! ! ok( ! $stop_called == 0, ! "_stop wasn't called" ! ); ! ! ok( ! $child_called == 0, ! "_child wasn't called" ! ); ! ! ok( ! $parent_called == 0, ! "_parent wasn't called" ! ); my $expected; if ($] >= 5.004 and $] < 5.005) { ! diag( "Seriously. We've had to create special cases just to cater" ); ! diag( "to your freakish 'legacy buggy perl' fetish. Consider upgrading" ); $expected = 0; } *************** *** 575,585 **** } ! print 'not ' unless $sessions_destroyed == $expected; ! print "ok 32 # dest $sessions_destroyed sessions (expected $expected)\n"; # 5.004 and 5.005 have some nasty gc issues. Near as I can tell, # data inside the heap is surviving the session DESTROY. This ! # isnt possible in a sane and normal world. So if this is giving ! # you fits, please consider upgrading perl to at least 5.6.1. my $expected; if($] >= '5.006') { --- 589,600 ---- } ! ok( ! $sessions_destroyed == $expected, ! "destroyed $sessions_destroyed sessions (expected $expected)" ! ); # 5.004 and 5.005 have some nasty gc issues. Near as I can tell, # data inside the heap is surviving the session DESTROY. This ! # isnt possible in a sane and normal world. my $expected; if($] >= '5.006') { *************** *** 588,591 **** --- 603,608 ---- elsif ($] == 5.005_04) { $expected = 3; + diag( "Here's yet another special test case to work around memory" ); + diag( "leaks in Perl $]." ); } else { *************** *** 593,598 **** } ! print "not " unless $objects_destroyed == $expected; ! print "ok 33 # dest $objects_destroyed objects (expected $expected)\n"; # This simple session just makes sure we can start another Session and --- 610,617 ---- } ! ok( ! $objects_destroyed == $expected, ! "destroyed $objects_destroyed objects (expected $expected)" ! ); # This simple session just makes sure we can start another Session and *************** *** 612,651 **** # beyond, and it's not built for threading. ! use Config; ! if ( ! $] >= 5.008 and ! exists $INC{"Tk.pm"} and ! !$Config{useithreads} ! ) { ! foreach (34..39) { ! print( ! "not ok $_ # Skip: Restarting Tk dumps core in single-threaded perl $]\n" ! ); ! } ! } ! else { POE::Session->create( options => { trace => 1, default => 1, debug => 1 }, inline_states => { _start => sub { ! print "ok 34\n"; $_[KERNEL]->yield("woot"); $_[KERNEL]->delay(narf => 1); }, woot => sub { ! print "ok 36\n"; }, narf => sub { ! print "ok 37\n"; }, _stop => sub { ! print "ok 38\n"; }, } ); - print "ok 35\n"; POE::Kernel->run(); ! print "ok 39\n"; } --- 631,664 ---- # beyond, and it's not built for threading. ! SKIP: { ! use Config; ! skip "Restarting Tk dumps core in single-threaded perl $]", 6 if ( ! $] >= 5.008 and ! exists $INC{"Tk.pm"} and ! !$Config{useithreads} ! ); ! POE::Session->create( options => { trace => 1, default => 1, debug => 1 }, inline_states => { _start => sub { ! pass("restarted event loop session _start"); $_[KERNEL]->yield("woot"); $_[KERNEL]->delay(narf => 1); }, woot => sub { ! pass("restarted event loop session yield()"); }, narf => sub { ! pass("restarted event loop session timer delay()"); }, _stop => sub { ! pass("restarted event loop session _stop"); }, } ); POE::Kernel->run(); ! pass("restarted event loop returned normally"); } Index: wheel_accept.pm =================================================================== RCS file: /cvsroot/poe/poe/tests/30_loops/00_base/wheel_accept.pm,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** wheel_accept.pm 4 Sep 2004 22:50:39 -0000 1.1 --- wheel_accept.pm 28 Jun 2005 06:18:21 -0000 1.2 *************** *** 8,23 **** use IO::Socket; - use TestSetup qw(ok not_ok ok_if results test_setup many_not_ok); - sub POE::Kernel::ASSERT_DEFAULT () { 1 } sub POE::Kernel::TRACE_DEFAULT () { 1 } sub POE::Kernel::TRACE_FILENAME () { "./test-output.err" } use POE qw(Wheel::ListenAccept Wheel::SocketFactory); ! test_setup(0, "Network access (and permission) required to run this test") ! unless -f 'run_network_tests'; ! &test_setup(4); ### A listening session. --- 8,23 ---- use IO::Socket; sub POE::Kernel::ASSERT_DEFAULT () { 1 } sub POE::Kernel::TRACE_DEFAULT () { 1 } sub POE::Kernel::TRACE_FILENAME () { "./test-output.err" } + use Test::More; use POE qw(Wheel::ListenAccept Wheel::SocketFactory); ! unless (-f "run_network_tests") { ! plan skip_all => "Network access (and permission) required to run this test"; ! } ! plan tests => 2; ### A listening session. *************** *** 33,41 **** if (defined $listening_socket) { ! &ok(2); } else { ! ¬_ok(2); ! ¬_ok(3); return; } --- 33,41 ---- if (defined $listening_socket) { ! pass("created listening socket"); } else { ! fail("created listening socket"); ! fail("listening socket accepted connections"); return; } *************** *** 57,61 **** sub listener_stop { ! &ok_if(3, $_[HEAP]->{accept_count} == 5); } --- 57,64 ---- sub listener_stop { ! ok( ! $_[HEAP]->{accept_count} == 5, ! "listening socket accepted connections" ! ); } *************** *** 93,98 **** ### Main loop. - &ok(1); - POE::Session->create( inline_states => { --- 96,99 ---- *************** *** 117,122 **** $poe_kernel->run(); - &ok(4); - &results(); - 1; --- 118,120 ---- Index: wheel_sf_ipv6.pm =================================================================== RCS file: /cvsroot/poe/poe/tests/30_loops/00_base/wheel_sf_ipv6.pm,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** wheel_sf_ipv6.pm 21 Apr 2005 17:38:44 -0000 1.3 --- wheel_sf_ipv6.pm 28 Jun 2005 06:18:21 -0000 1.4 *************** *** 7,11 **** use strict; use lib qw(./mylib ../mylib ../lib ./lib); - use TestSetup; use Socket; --- 7,10 ---- *************** *** 32,35 **** --- 31,36 ---- } + # Not Test::More, because I'm pretty sure skip_all calls Perl's + # regular exit(). if ($error) { print "1..0 # Skip $error\n"; *************** *** 47,52 **** # Congratulations! We made it this far! ! test_setup(5); ! ok(1); warn( --- 48,52 ---- # Congratulations! We made it this far! ! use Test::More tests => 3; warn( *************** *** 94,106 **** sub server_got_disconnect { my $heap = $_[HEAP]; ! ok_if(2, $heap->{put_count} == $heap->{flush_count}); } sub server_got_error { my ($syscall, $errno, $error) = @_[ARG0..ARG2]; ! ok( ! 2, ! "skipped: AF_INET6 probably not supported ($syscall error $errno: $error)" ! ); } --- 94,108 ---- sub server_got_disconnect { my $heap = $_[HEAP]; ! ok( ! $heap->{put_count} == $heap->{flush_count}, ! "server put_count matches flush_count" ! ); } sub server_got_error { my ($syscall, $errno, $error) = @_[ARG0..ARG2]; ! SKIP: { ! skip "AF_INET6 probably not supported ($syscall error $errno: $error)", 1 ! } } *************** *** 135,139 **** } elsif ($line =~ s/^2: //) { ! &ok_if(3, $line eq 'this is a test'); $kernel->post(server => "shutdown"); $kernel->yield("shutdown"); --- 137,144 ---- } elsif ($line =~ s/^2: //) { ! ok( ! $line eq "this is a test", ! "received input" ! ); $kernel->post(server => "shutdown"); $kernel->yield("shutdown"); *************** *** 147,171 **** sub client_got_disconnect { my $heap = $_[HEAP]; ! ok_if(4, $heap->{put_count} == $heap->{flush_count}); } sub client_got_connect_error { my ($syscall, $errno, $error) = @_[ARG0..ARG2]; ! ok( ! 3, ! "skipped: AF_INET6 probably not supported... [truncated message content] |