Skip to content

Commit

Permalink
added two new test suites
Browse files Browse the repository at this point in the history
  • Loading branch information
@rcaputo
rcaputo committed Mar 28, 2000
1 parent b35e3b7 commit c1469b6
Show file tree
Hide file tree
Showing 5 changed files with 377 additions and 49 deletions.
4 changes: 4 additions & 0 deletions Changes
View file
Expand Up @@ -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 (!!!)
---------------------
Expand Down
2 changes: 2 additions & 0 deletions MANIFEST
View file
Expand Up @@ -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
125 changes: 76 additions & 49 deletions lib/POE/Kernel.pm
View file
Expand Up @@ -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

#------------------------------------------------------------------------------
Expand Down Expand Up @@ -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]
);
}

#==============================================================================
Expand Down Expand Up @@ -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];
}
}

Expand Down Expand Up @@ -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 %};
}
Expand Down Expand Up @@ -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;
}

#------------------------------------------------------------------------------
Expand All @@ -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
);
}

#------------------------------------------------------------------------------
Expand Down
105 changes: 105 additions & 0 deletions tests/03_aliases.t
View file
@@ -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;

0 comments on commit c1469b6

Please sign in to comment.