Permalink
Browse files

added two new test suites

  • Loading branch information...
1 parent b35e3b7 commit c1469b61db90c814652d709a89e72a8d2d10faee @rcaputo committed Mar 28, 2000
Showing with 377 additions and 49 deletions.
  1. +4 −0 Changes
  2. +2 −0 MANIFEST
  3. +76 −49 lib/POE/Kernel.pm
  4. +105 −0 tests/03_aliases.t
  5. +190 −0 tests/04_selects.t
View
4 Changes
@@ -47,6 +47,10 @@ Removed poing.perl, which has evolved into a separate program in its
own right. It's now available from the author's page at
<http://www.newts.org/~troc/poe-grams.html>.
+Added t/03_aliases.t to test session aliases.
+
+Added t/04_selects.t to test filehandle watchers.
+
0.10 2000.03.23 (!!!)
---------------------
View
2 MANIFEST
@@ -57,3 +57,5 @@ samples/wheels.perl
samples/wheels2.perl
t/01_sessions.t
t/02_alarms.t
+t/03_aliases.t
+t/04_selects.t
View
125 lib/POE/Kernel.pm
@@ -147,6 +147,16 @@ macro define_assert (<const>) {
defined &ASSERT_<const> or eval 'sub ASSERT_<const> { ASSERT_DEFAULT }';
}
+macro test_resolve (<name>,<resolved>) {
+ unless (defined <resolved>) {
+ ASSERT_SESSIONS and do {
+ confess "Cannot resolve <name> into a session reference\n";
+ };
+ $! = ESRCH;
+ return undef;
+ }
+}
+
# MACROS END <-- search tag for editing
#------------------------------------------------------------------------------
@@ -411,20 +421,16 @@ sub sig {
# Public interface for posting signal events.
sub signal {
- my ($self, $session, $signal) = @_;
+ my ($self, $destination, $signal) = @_;
- $session = {% alias_resolve $session %};
+ my $session = {% alias_resolve $destination %};
+ {% test_resolve $destination, $session %}
- if (defined $session) {
- $self->_enqueue_state( $session, $self->[KR_ACTIVE_SESSION],
- EN_SIGNAL, ET_SIGNAL,
- [ $signal ],
- time(), (caller)[1,2]
- );
- }
- else {
- $! = ESRCH;
- }
+ $self->_enqueue_state( $session, $self->[KR_ACTIVE_SESSION],
+ EN_SIGNAL, ET_SIGNAL,
+ [ $signal ],
+ time(), (caller)[1,2]
+ );
}
#==============================================================================
@@ -1218,34 +1224,48 @@ sub session_free {
sub trace_gc_refcount {
my ($self, $session) = @_;
my $ss = $self->[KR_SESSIONS]->{$session};
- warn ",----- GC test for ", {% ssid %}, " -----\n";
+ warn "+----- GC test for ", {% ssid %}, " -----\n";
warn "| ref. count : $ss->[SS_REFCOUNT]\n";
warn "| event count : $ss->[SS_EVCOUNT]\n";
warn "| child sessions: ", scalar(keys(%{$ss->[SS_CHILDREN]})), "\n";
warn "| handles in use: ", scalar(keys(%{$ss->[SS_HANDLES]})), "\n";
warn "| aliases in use: ", scalar(keys(%{$ss->[SS_ALIASES]})), "\n";
warn "| extra refs : ", scalar(keys(%{$ss->[SS_EXTRA_REFS]})), "\n";
- warn "`---------------------------------------------------\n";
- warn "<<< GARBAGE: $session\n" unless ($ss->[SS_REFCOUNT]);
+ warn "+---------------------------------------------------\n";
+ warn("| Session ", {% ssid %}, " is garbage; recycling it...\n")
+ unless $ss->[SS_REFCOUNT];
+ warn "+---------------------------------------------------\n";
}
sub assert_gc_refcount {
my ($self, $session) = @_;
my $ss = $self->[KR_SESSIONS]->{$session};
+ # Calculate the total reference count based on the number of
+ # discrete references kept.
+
my $calc_ref =
( $ss->[SS_EVCOUNT] +
scalar(keys(%{$ss->[SS_CHILDREN]})) +
scalar(keys(%{$ss->[SS_HANDLES]})) +
scalar(keys(%{$ss->[SS_EXTRA_REFS]})) +
scalar(keys(%{$ss->[SS_ALIASES]}))
);
- die if ($calc_ref != $ss->[SS_REFCOUNT]);
+
+ # The calculated reference count really ought to match the one POE's
+ # been keeping track of all along.
+
+ die "session ", {% ssid %}, " has a reference count inconsistency\n"
+ if $calc_ref != $ss->[SS_REFCOUNT];
+
+ # Compare held handles against reference counts for them.
foreach (values %{$ss->[SS_HANDLES]}) {
$calc_ref = $_->[SH_VECCOUNT]->[VEC_RD] +
$_->[SH_VECCOUNT]->[VEC_WR] + $_->[SH_VECCOUNT]->[VEC_EX];
- die if ($calc_ref != $_->[SH_REFCOUNT]);
+
+ die "session ", {% ssid %}, " has a handle reference count inconsistency\n"
+ if $calc_ref != $_->[SH_REFCOUNT];
}
}
@@ -1286,7 +1306,8 @@ sub _enqueue_state {
}
# Special case: Two states in the queue. The new state enters
- # between them.
+ # between them, because it's not before the first one or after the
+ # last one.
elsif (@$kr_states == 2) {
splice @$kr_states, 1, 0, {% state_to_enqueue %};
}
@@ -1364,21 +1385,21 @@ sub _enqueue_state {
sub post {
my ($self, $destination, $state_name, @etc) = @_;
- $destination = {% alias_resolve $destination %};
- if (defined $destination) {
- $self->_enqueue_state( $destination, $self->[KR_ACTIVE_SESSION],
- $state_name, ET_USER,
- \@etc,
- time(), (caller)[1,2]
- );
- return 1;
- }
- ASSERT_SESSIONS and do {
- warn "Cannot resolve alias $destination into a session\n";
- confess;
- };
- $! = ESRCH;
- return undef;
+ # Attempt to resolve the destination session reference against
+ # various things.
+
+ my $session = {% alias_resolve $destination %};
+ {% test_resolve $destination, $session %}
+
+ # Enqueue the state for "now", which simulates FIFO in our
+ # time-ordered queue.
+
+ $self->_enqueue_state( $destination, $self->[KR_ACTIVE_SESSION],
+ $state_name, ET_USER,
+ \@etc,
+ time(), (caller)[1,2]
+ );
+ return 1;
}
#------------------------------------------------------------------------------
@@ -1401,22 +1422,28 @@ sub yield {
sub call {
my ($self, $destination, $state_name, @etc) = @_;
- $destination = {% alias_resolve $destination %};
-
- if (defined $destination) {
- $! = 0;
- return $self->_dispatch_state( $destination, $self->[KR_ACTIVE_SESSION],
- $state_name, ET_USER,
- \@etc,
- time(), (caller)[1,2], undef
- );
- }
- ASSERT_SESSIONS and do {
- warn "Cannot resolve alias $destination into session\n";
- confess;
- };
- $! = ESRCH;
- return undef;
+ # Attempt to resolve the destination session reference against
+ # various things.
+
+ my $session = {% alias_resolve $destination %};
+ {% test_resolve $destination, $session %}
+
+ # Dispatch the state right now, bypassing the queue altogether.
+ # This tends to be a Bad Thing to Do, but it's useful for
+ # synchronous events like selects'. -><- The difference between
+ # synchronous and asynchronous events should be made more clear in
+ # the documentation, so that people have a tendency not to abuse
+ # them. I discovered in xws that that mixing the two types makes it
+ # harder than necessary to write deterministic programs, but the
+ # difficulty can be ameliorated if programmers set some base rules
+ # and stick to them.
+
+ $! = 0;
+ return $self->_dispatch_state( $destination, $self->[KR_ACTIVE_SESSION],
+ $state_name, ET_USER,
+ \@etc,
+ time(), (caller)[1,2], undef
+ );
}
#------------------------------------------------------------------------------
View
105 tests/03_aliases.t
@@ -0,0 +1,105 @@
+#!/usr/bin/perl -w
+# $Id$
+
+# Tests basic session aliases.
+
+use strict;
+use lib qw(./lib ../lib);
+use TestSetup qw(10);
+
+# Turn on all asserts.
+sub POE::Kernel::ASSERT_DEFAULT () { 1 }
+
+use POE;
+
+### Define a simple state machine.
+
+sub machine_start {
+ my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
+ my $resolved_session;
+
+ $heap->{idle_count} = $heap->{zombie_count} = 0;
+
+ # Set an alias.
+ $kernel->alias_set( 'new name' );
+
+ # Resolve weak, stringified session reference.
+ $resolved_session = $kernel->alias_resolve( "$session" );
+ print "not " unless $resolved_session eq $session;
+ print "ok 3\n";
+
+ # Resolve against session ID.
+ $resolved_session = $kernel->alias_resolve( $session->ID );
+ print "not " unless $resolved_session eq $session;
+ print "ok 4\n";
+
+ # Resolve against alias.
+ $resolved_session = $kernel->alias_resolve( 'new name' );
+ print "not " unless $resolved_session eq $session;
+ print "ok 5\n";
+
+ # Resolve against blessed session reference.
+ $resolved_session = $kernel->alias_resolve( $session );
+ print "not " unless $resolved_session eq $session;
+ print "ok 6\n";
+
+ # Resolve against something that doesn't exist.
+ $resolved_session = $kernel->alias_resolve( 'nonexistent' );
+ print "not " if defined $resolved_session;
+ print "ok 7\n";
+}
+
+# Catch SIGIDLE and SIGZOMBIE.
+
+sub machine_signal {
+ my ($kernel, $heap, $signal) = @_[KERNEL, HEAP, ARG0];
+
+ if ($signal eq 'IDLE') {
+ $heap->{idle_count}++;
+ return 1;
+ }
+
+ if ($signal eq 'ZOMBIE') {
+ $heap->{zombie_count}++;
+ return 1;
+ }
+
+ # Don't handle other signals.
+ return 0;
+}
+
+# Make sure we got one SIGIDLE and one SIGZOMBIE.
+
+sub machine_stop {
+ my $heap = $_[HEAP];
+
+ print "not " unless $heap->{idle_count} == 1;
+ print "ok 8\n";
+
+ print "not " unless $heap->{zombie_count} == 1;
+ print "ok 9\n";
+}
+
+### Main loop.
+
+print "ok 1\n";
+
+# Spawn a state machine for testing.
+
+POE::Session->create
+ ( inline_states =>
+ { _start => \&machine_start,
+ _signal => \&machine_signal,
+ _stop => \&machine_stop
+ },
+ );
+
+print "ok 2\n";
+
+# Now run the kernel until there's nothing left to do.
+
+$poe_kernel->run();
+
+print "ok 10\n";
+
+exit;
View
190 tests/04_selects.t
@@ -0,0 +1,190 @@
+#!/usr/bin/perl -w
+# $Id$
+
+# Tests basic select operations.
+
+use strict;
+use lib qw(./lib ../lib);
+use TestSetup qw(99);
+
+# Turn on all asserts.
+sub POE::Kernel::ASSERT_DEFAULT () { 1 }
+
+use POE;
+use Socket;
+use Symbol qw(gensym);
+
+### Test parameters.
+
+my $pair_count = 10;
+my $chat_count = 100;
+
+### 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
+# other end of the pair. The master and slave chat a while, then the
+# slave exits (odd pairs) or the master exits (even pairs).
+# Everything should shut down cleanly.
+
+# We'll use send and recv with small enough packets to avoid worrying
+# about combining broken datagrams.
+
+### Master session.
+
+sub master_start {
+ my ($kernel, $heap, $test_index) = @_[KERNEL, HEAP, ARG0];
+
+ $test_index *= 2;
+
+ # Create a socket pain.
+ my ($master_socket, $slave_socket) = (gensym, gensym);
+ my $proto = getprotobyname('tcp');
+ die "could not get tcp protocol number: $!" unless defined $proto;
+ socketpair($master_socket, $slave_socket, AF_INET, SOCK_STREAM, $proto)
+ or die "could not open a socket pain: $!";
+
+ # Select on one side.
+ select_read($master_socket, 'input');
+
+ # Give the other side to a newly spawned session.
+ POE::Session->create
+ ( inline_states =>
+ { _start => \&slave_start,
+ _stop => \&slave_stop,
+ input => \&slave_input,
+ },
+ args => [ $slave_socket, $test_index + 1 ],
+ );
+
+ # Save some values for later.
+ $heap->{socket} = $master_socket;
+ $heap->{test_index} = $test_index;
+ $heap->{test_count} = 0;
+}
+
+sub master_stop {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+
+ # Determine if we were successful.
+ $test_results[$heap->{test_index}] = ($heap->{test_count} == $chat_count);
+}
+
+sub master_got_input {
+ my ($kernel, $heap, $handle) = @_[KERNEL, HEAP, ARG0];
+
+ my $buffer = '';
+ my $got = recv($handle, $buffer, 4, 0);
+
+ # The other session requested a quit. Shut down gracefully.
+ if ($buffer eq 'quit') {
+ select_read($handle);
+ return;
+ }
+
+ # The other session sent a ping. Count it, and send a pong.
+ if ($buffer eq 'ping') {
+ $heap->{test_count}++;
+ my $sent = send($handle, 'pong', 0);
+
+ # Stop on error.
+ select_read($handle) unless $sent == 4;
+ return;
+ }
+}
+
+### Slave session.
+
+sub slave_start {
+ my ($kernel, $heap, $handle, $test_index) = @_[KERNEL, HEAP, ARG0, ARG1];
+
+ # Select on our socket.
+ select_read($handle, 'input');
+
+ # Say hello to the master session.
+ send($handle, 'ping', 0);
+}
+
+sub slave_stop {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+
+ # Determine if we were successful.
+ $test_results[$heap->{test_index}] = ($heap->{test_count} == $chat_count);
+}
+
+sub slave_got_input {
+ my ($kernel, $heap, $handle) = @_[KERNEL, HEAP, ARG0];
+
+ my $buffer = '';
+ my $got = recv($handle, $buffer, 4, 0);
+
+ # The other session requested a quit. Shut down gracefully.
+ if ($buffer eq 'quit') {
+ select_read($handle);
+ return;
+ }
+
+ # The other session sent a pong.
+ if ($buffer eq 'pong') {
+
+ # Count it.
+ $heap->{test_count}++;
+
+ # Send another ping if we're not done.
+ if ($heap->{test_count} < $chat_count) {
+ my $sent = send($handle, 'ping', 0);
+
+ # Stop on error.
+ select_read($handle) unless $sent == 4;
+ }
+
+ # Otherwise we're done. Send a quit, and quit ourselves.
+ else {
+ my $sent = send($handle, 'quit', 0);
+
+ # Stop on error.
+ select_read($handle) unless $sent == 4;
+ }
+
+ }
+
+ # Received a message from the master session.
+ # Make a note.
+ # Send a response to the master.
+
+}
+
+### 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,
+ input => \&master_got_input,
+ },
+ args => [ $index ],
+ );
+}
+
+print "ok 2\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++) {
+ "not " unless $test_results[$index];
+ print "ok ", $index + 3, "\n";
+}
+
+# And one to grow on.
+print "ok 99\n";
+
+exit;

0 comments on commit c1469b6

Please sign in to comment.