Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

TestPipe.pm; 20_accept.t; better select management

  • Loading branch information...
commit e9f3ab23f23965a75fac5f4442503e6f59969a71 1 parent 4370848
@rcaputo authored
View
34 Changes
@@ -43,7 +43,9 @@ Version numbers have four fields: X.YYZZAA
| code. Migrate SocketFactory's code to ListenAccept, and write
| a test based on IO::Socket::INET sockets.
|
-| Split the samples out into a separate distribution.
+| Split the samples out into a separate distribution. POE's
+| distribution tree is over 800 kilobytes! Most of it's supporting
+| documentation, tests, and samples.
|
| Revise the POE web pages.
|
@@ -57,10 +59,32 @@ Version numbers have four fields: X.YYZZAA
0.1104 2000.??.??
-----------------
-Thanks to jaxdahl's donation of shell time on a Windows 2000 machine,
-I think I've found a bug in POE::Preprocessor. This bug only occurs
-on Windows machines so far. Although it should also appear on other
-multi-byte newline systems, it doesn't on my OS/2 system.
+Jaxdahl donated some shell time on his Win32 machine, allowing me to
+figure out why POE was failing miserably with ActiveState's Perl port.
+I made a bad assumption about source code newlines in
+POE::Preprocessor.
+
+Wheel::ListenAccept wasn't as lagged behind Wheel::SocketFactory as I
+had thought. It required only minor changes to be brought up to date.
+
+Skip some tests on Win32 because pipes can't be made non-blocking
+there.
+
+Brian Buchanan found and fixed a problem where SIGCHLD would not be
+delivered when child processes exited by signal.
+
+Added t/20_accept.t to test Wheel::ListenAccept.
+
+Wrote lib/TestPipe.pm. This file tries to make a two-way pipe at any
+cost. It tries socketpair(2) in the UNIX domain, socketpair(2) in the
+INET domain, a pair of pipe(2)s, and finally a plain INET domain
+socket. This would make a great basis for an open3 thingy.
+
+select(2) bits are keyed on fileno. POE's selects were keyed on file
+handle. Several dup(2)'d handles could have the same fileno. POE
+would manage the select(2) bits based on reference counts for handles.
+This was bad. Changed POE to manage its own selects by fileno
+instead of filehandle. This worked, much to my surprise.
0.1103 2000.08.06
View
2  MANIFEST
@@ -33,6 +33,7 @@ lib/coverage.perl
lib/Devel/Null.pm
lib/Devel/Trace.pm
lib/MyOtherFreezer.pm
+lib/TestPipe.pm
lib/TestSetup.pm
samples/create.perl
samples/fakelogin.perl
@@ -83,3 +84,4 @@ t/16_filter_stream.t
t/17_filter_ref.t
t/18_filter_line.t
t/19_filterchange.t
+t/20_accept.t
View
4 README
@@ -61,12 +61,12 @@ Finally you can install it:
Test Results and Coverage
-------------------------
-These are the `make test' results for POE 0.1103. Hardware: Cyrix
+These are the `make test' results for POE 0.1104. Hardware: Cyrix
P166+; 64MB RAM. Software: OS/2 4, fix 13; perl 5.6.0; no Perl/Tk; no
Event.
All tests successful, 3 tests skipped.
- Files=20, Tests=361, 191 wallclock secs ( 0.00 cusr + 0.00 csys = 0.00 CPU)
+ Files=21, Tests=365, 190 wallclock secs ( 0.00 cusr + 0.00 csys = 0.00 CPU)
These are the `make test' results for POE 0.1103. Hardware: AMD
486-40 (overclocked to 50); 16MB RAM. Software: FreeBSD 4.0-STABLE;
View
125 lib/POE/Kernel.pm
@@ -131,12 +131,12 @@ macro collect_garbage (<session>) {
}
}
-macro validate_handle (<handle>,<vector>) {
- # Don't bother if the kernel isn't tracking the handle.
- return 0 unless exists $self->[KR_HANDLES]->{<handle>};
+macro validate_fileno (<fileno>,<vector>) {
+ # Don't bother if the kernel isn't tracking the file.
+ return 0 unless exists $self->[KR_FILES]->{<fileno>};
- # Don't bother if the kernel isn't tracking the handle's write status.
- return 0 unless $self->[KR_HANDLES]->{<handle>}->[HND_VECCOUNT]->[<vector>];
+ # Don't bother if the kernel isn't tracking the file mode.
+ return 0 unless $self->[KR_FILES]->{<fileno>}->[HND_VECCOUNT]->[<vector>];
}
macro remove_alias (<session>,<alias>) {
@@ -172,7 +172,7 @@ macro test_for_idle_poe_kernel {
warn( ",----- Kernel Activity -----\n",
"| States : ", scalar(@{$self->[KR_STATES]}), "\n",
"| Alarms : ", scalar(@{$self->[KR_ALARMS]}), "\n",
- "| Handles: ", scalar(keys(%{$self->[KR_HANDLES]})), "\n",
+ "| Files : ", scalar(keys(%{$self->[KR_FILES]})), "\n",
"| Extra : ", $self->[KR_EXTRA_REFS], "\n",
"`---------------------------\n"
);
@@ -180,7 +180,7 @@ macro test_for_idle_poe_kernel {
unless ( @{$self->[KR_STATES]} or
@{$self->[KR_ALARMS]} or
- keys(%{$self->[KR_HANDLES]}) or
+ keys(%{$self->[KR_FILES]}) or
$self->[KR_EXTRA_REFS]
) {
$self->_enqueue_state( $self, $self,
@@ -223,7 +223,8 @@ macro dispatch_due_alarms {
macro dispatch_ready_selects {
my @selects =
- values %{ $self->[KR_HANDLES]->{$handle}->[HND_SESSIONS]->[$vector] };
+ values %{ $self->[KR_FILES]->{fileno($handle)}->[HND_SESSIONS]->[$vector]
+ };
foreach my $select (@selects) {
$self->_dispatch_state
@@ -363,12 +364,12 @@ enum + SS_SIGNALS SS_ALIASES SS_PROCESSES SS_ID SS_EXTRA_REFS SS_ALCOUNT
enum SH_HANDLE SH_REFCOUNT SH_VECCOUNT
# The Kernel object. KR_SIZE goes last (it's the index count).
-enum KR_SESSIONS KR_VECTORS KR_HANDLES KR_STATES KR_SIGNALS KR_ALIASES
+enum KR_SESSIONS KR_VECTORS KR_FILES KR_STATES KR_SIGNALS KR_ALIASES
enum + KR_ACTIVE_SESSION KR_PROCESSES KR_ALARMS KR_ID KR_SESSION_IDS
enum + KR_ID_INDEX KR_WATCHER_TIMER KR_WATCHER_IDLE KR_EXTRA_REFS KR_SIZE
# Handle structure.
-enum HND_HANDLE HND_REFCOUNT HND_VECCOUNT HND_SESSIONS HND_FILENO HND_WATCHERS
+enum HND_HANDLE HND_REFCOUNT HND_VECCOUNT HND_SESSIONS HND_WATCHERS
# Handle session structure.
enum HSS_HANDLE HSS_SESSION HSS_STATE
@@ -439,8 +440,8 @@ const FIFO_DISPATCH_TIME 0.01
#
# session IDs: { $id => $session, ... }
#
-# handles:
-# { $handle =>
+# files:
+# { $fileno =>
# [ $handle,
# $refcount,
# [ $ref_r, $ref_w, $ref_x ],
@@ -448,7 +449,6 @@ const FIFO_DISPATCH_TIME 0.01
# { $session => [ $handle, $session, $state ], .. },
# { $session => [ $handle, $session, $state ], .. }
# ],
-# fileno(),
# [ $watcher_r, $watcher_w, $watcher_x ],
# ]
# };
@@ -640,7 +640,7 @@ sub new {
my $self = $poe_kernel = bless
[ { }, # KR_SESSIONS
[ '', '', '' ], # KR_VECTORS
- { }, # KR_HANDLES
+ { }, # KR_FILES
[ ], # KR_STATES
{ }, # KR_SIGNALS
{ }, # KR_ALIASES
@@ -1243,7 +1243,7 @@ sub run {
# POE::Kernel's data structure and made them all lexicals instead
# of members of $self.
my $kr_states = $self->[KR_STATES];
- my $kr_handles = $self->[KR_HANDLES];
+ my $kr_files = $self->[KR_FILES];
my $kr_sessions = $self->[KR_SESSIONS];
my $kr_vectors = $self->[KR_VECTORS];
my $kr_alarms = $self->[KR_ALARMS];
@@ -1304,7 +1304,7 @@ sub run {
# Avoid looking at filehandles if we don't need to.
- if ($timeout || keys(%$kr_handles)) {
+ if ($timeout || keys(%$kr_files)) {
# Check filehandles, or wait for a period of time to elapse.
my $hits = select( my $rout = $kr_vectors->[VEC_RD],
@@ -1315,7 +1315,7 @@ sub run {
ASSERT_SELECT and do {
if ($hits < 0) {
- die "select error: $!"
+ confess "select error: $!"
unless ( ($! == EINPROGRESS) or
($! == EWOULDBLOCK) or
($! == EINTR)
@@ -1346,10 +1346,10 @@ sub run {
# This is where they're gathered. It's a variant on a neat
# hack Silmaril came up with.
- # -><- This does extra work. Some of $%kr_handles don't
- # have all their bits set (for example; VEX_EX is rarely
- # used). It might be more efficient to split this into
- # three greps, for just the vectors that need to be checked.
+ # -><- This does extra work. Some of $%kr_files don't have
+ # all their bits set (for example; VEX_EX is rarely used).
+ # It might be more efficient to split this into three greps,
+ # for just the vectors that need to be checked.
# -><- It has been noted that map is slower than foreach
# when the size of a list is grown. The list is exploded on
@@ -1357,20 +1357,20 @@ sub run {
# than just pushing on a list. Evil probably ensues here.
my @selects =
- map { ( ( vec($rout, $_->[HND_FILENO], 1)
- ? values(%{$_->[HND_SESSIONS]->[VEC_RD]})
+ map { ( ( vec($rout, $_, 1)
+ ? values(%{$kr_files->{$_}->[HND_SESSIONS]->[VEC_RD]})
: ( )
),
- ( vec($wout, $_->[HND_FILENO], 1)
- ? values(%{$_->[HND_SESSIONS]->[VEC_WR]})
+ ( vec($wout, $_, 1)
+ ? values(%{$kr_files->{$_}->[HND_SESSIONS]->[VEC_WR]})
: ( )
),
- ( vec($eout, $_->[HND_FILENO], 1)
- ? values(%{$_->[HND_SESSIONS]->[VEC_EX]})
+ ( vec($eout, $_, 1)
+ ? values(%{$kr_files->{$_}->[HND_SESSIONS]->[VEC_EX]})
: ( )
)
)
- } values %$kr_handles;
+ } keys %$kr_files;
TRACE_SELECT and do {
if (@selects) {
@@ -1464,7 +1464,7 @@ sub run {
{% kernel_leak_hash KR_PROCESSES %}
{% kernel_leak_hash KR_SESSION_IDS %}
- {% kernel_leak_hash KR_HANDLES %}
+ {% kernel_leak_hash KR_FILES %}
{% kernel_leak_hash KR_SESSIONS %}
{% kernel_leak_hash KR_ALIASES %}
@@ -1695,7 +1695,7 @@ sub _invoke_state {
# stopping for some other reason. This is perl Perl Cookbook
# recipe 16.19 and the waitpid(2) manpage.
- if (WIFEXITED($?)) {
+ if (WIFEXITED($?) or WIFSIGNALED($?)) {
# Map the process ID to a session reference. First look for a
# session registered via $kernel->fork(). Next validate the
@@ -1707,7 +1707,8 @@ sub _invoke_state {
exists $self->[KR_SESSIONS]->{$parent_session}
);
- # Enqueue the signal event.
+ # Enqueue the signal event. -><- No way to determine whether
+ # the child left via exit or a signal. Add another parameter?
$self->_enqueue_state( $parent_session, $self,
EN_SIGNAL, ET_SIGNAL,
@@ -1769,7 +1770,7 @@ sub _invoke_state {
elsif ($state eq EN_SIGNAL) {
if ($etc->[0] eq 'IDLE') {
- unless (@{$self->[KR_STATES]} || keys(%{$self->[KR_HANDLES]})) {
+ unless (@{$self->[KR_STATES]} || keys(%{$self->[KR_FILES]})) {
$self->_enqueue_state( $self, $self,
EN_SIGNAL, ET_SIGNAL,
[ 'ZOMBIE' ],
@@ -2247,17 +2248,17 @@ sub delay_add {
sub _internal_select {
my ($self, $session, $handle, $state, $select_index) = @_;
- my $kr_handles = $self->[KR_HANDLES];
+ my $kr_files = $self->[KR_FILES];
+ my $fileno = fileno($handle);
# Register a select state.
if ($state) {
- unless (exists $kr_handles->{$handle}) {
- $kr_handles->{$handle} =
+ unless (exists $kr_files->{$fileno}) {
+ $kr_files->{$fileno} =
[ $handle, # HND_HANDLE
0, # HND_REFCOUNT
[ 0, 0, 0 ], # HND_VECCOUNT (VEC_RD, VEC_WR, VEC_EX)
[ { }, { }, { } ], # HND_SESSIONS (VEC_RD, VEC_WR, VEC_EX)
- fileno($handle) # HND_FILENO
];
# For DOSISH systems like OS/2
@@ -2293,25 +2294,25 @@ sub _internal_select {
select((select($handle), $| = 1)[0]);
}
- # KR_HANDLES
- my $kr_handle = $kr_handles->{$handle};
+ # KR_FILES
+ my $kr_file = $kr_files->{$fileno};
# If this session hasn't already been watching the filehandle,
# then modify the handle's reference counts and perhaps turn on
# the appropriate select bit.
- unless (exists $kr_handle->[HND_SESSIONS]->[$select_index]->{$session}) {
+ unless (exists $kr_file->[HND_SESSIONS]->[$select_index]->{$session}) {
# Increment the handle's vector (Read, Write or Expedite)
# reference count. This helps the kernel know when to manage
# the handle's corresponding vector bit.
- $kr_handle->[HND_VECCOUNT]->[$select_index]++;
+ $kr_file->[HND_VECCOUNT]->[$select_index]++;
# If this is the first session to watch the handle, then turn
# its select bit on.
- if ($kr_handle->[HND_VECCOUNT]->[$select_index] == 1) {
+ if ($kr_file->[HND_VECCOUNT]->[$select_index] == 1) {
vec($self->[KR_VECTORS]->[$select_index], fileno($handle), 1) = 1;
# If we're using Tk, then we tell it to watch this filehandle
@@ -2341,7 +2342,7 @@ sub _internal_select {
if (POE_HAS_EVENT) {
- $kr_handle->[HND_WATCHERS]->[$select_index] =
+ $kr_file->[HND_WATCHERS]->[$select_index] =
Event->io
( fd => $handle,
poll => ( ( $select_index == VEC_RD )
@@ -2360,14 +2361,14 @@ sub _internal_select {
# sum of its read, write and expedite counts but kept separate
# for faster runtime checking).
- $kr_handle->[HND_REFCOUNT]++;
+ $kr_file->[HND_REFCOUNT]++;
}
# Record the session parameters in the kernel's handle structure,
# so we know what to do when the watcher unblocks. This
# overwrites a previous value, if any, or adds a new one.
- $kr_handle->[HND_SESSIONS]->[$select_index]->{$session} =
+ $kr_file->[HND_SESSIONS]->[$select_index]->{$session} =
[ $handle, $session, $state ];
# SS_HANDLES
@@ -2395,32 +2396,32 @@ sub _internal_select {
# session's destruction.
else {
- # KR_HANDLES
+ # KR_FILES
# Make sure the handle is deregistered with the kernel.
- if (exists $kr_handles->{$handle}) {
- my $kr_handle = $kr_handles->{$handle};
+ if (exists $kr_files->{$fileno}) {
+ my $kr_file = $kr_files->{$fileno};
# Make sure the handle was registered to the requested session.
- if (exists $kr_handle->[HND_SESSIONS]->[$select_index]->{$session}) {
+ if (exists $kr_file->[HND_SESSIONS]->[$select_index]->{$session}) {
# Remove the handle from the kernel's session record.
- delete $kr_handle->[HND_SESSIONS]->[$select_index]->{$session};
+ delete $kr_file->[HND_SESSIONS]->[$select_index]->{$session};
# Decrement the handle's reference count.
- $kr_handle->[HND_VECCOUNT]->[$select_index]--;
+ $kr_file->[HND_VECCOUNT]->[$select_index]--;
ASSERT_REFCOUNT and do {
- die if ($kr_handle->[HND_VECCOUNT]->[$select_index] < 0);
+ die if ($kr_file->[HND_VECCOUNT]->[$select_index] < 0);
};
# If the "vector" count drops to zero, then stop selecting the
# handle.
- unless ($kr_handle->[HND_VECCOUNT]->[$select_index]) {
+ unless ($kr_file->[HND_VECCOUNT]->[$select_index]) {
vec($self->[KR_VECTORS]->[$select_index], fileno($handle), 1) = 0;
# If we're using Tk, then we tell it to stop watching this
@@ -2453,8 +2454,8 @@ sub _internal_select {
# code.
if (POE_HAS_EVENT) {
- $kr_handle->[HND_WATCHERS]->[$select_index]->cancel();
- $kr_handle->[HND_WATCHERS]->[$select_index] = undef;
+ $kr_file->[HND_WATCHERS]->[$select_index]->cancel();
+ $kr_file->[HND_WATCHERS]->[$select_index] = undef;
}
# Shrink the bit vector by chopping zero octets from the
@@ -2471,12 +2472,12 @@ sub _internal_select {
# collection on it, as soon as whatever else in "user space"
# frees it.
- $kr_handle->[HND_REFCOUNT]--;
+ $kr_file->[HND_REFCOUNT]--;
ASSERT_REFCOUNT and do {
- die if ($kr_handle->[HND_REFCOUNT] < 0);
+ die if ($kr_file->[HND_REFCOUNT] < 0);
};
- unless ($kr_handle->[HND_REFCOUNT]) {
- delete $kr_handles->{$handle};
+ unless ($kr_file->[HND_REFCOUNT]) {
+ delete $kr_files->{$fileno};
}
}
}
@@ -2548,7 +2549,7 @@ sub select_expedite {
sub select_pause_write {
my ($self, $handle) = @_;
- {% validate_handle $handle, VEC_WR %}
+ {% validate_fileno fileno($handle), VEC_WR %}
# Turn off the select vector's write bit for us. We don't do any
# housekeeping since we're only pausing the handle. It's assumed
@@ -2565,7 +2566,7 @@ sub select_pause_write {
}
if (POE_HAS_EVENT) {
- $self->[KR_HANDLES]->{$handle}->[HND_WATCHERS]->[VEC_WR]->stop();
+ $self->[KR_FILES]->{fileno($handle)}->[HND_WATCHERS]->[VEC_WR]->stop();
}
return 0;
@@ -2576,7 +2577,7 @@ sub select_pause_write {
sub select_resume_write {
my ($self, $handle) = @_;
- {% validate_handle $handle, VEC_WR %}
+ {% validate_fileno fileno($handle), VEC_WR %}
# Turn off the select vector's write bit for us. We don't do any
# housekeeping since we're only pausing the handle. It's assumed
@@ -2593,7 +2594,7 @@ sub select_resume_write {
}
if (POE_HAS_EVENT) {
- $self->[KR_HANDLES]->{$handle}->[HND_WATCHERS]->[VEC_WR]->start();
+ $self->[KR_FILES]->{fileno($handle)}->[HND_WATCHERS]->[VEC_WR]->start();
}
return 1;
View
49 lib/POE/Wheel/ListenAccept.pm
@@ -4,7 +4,9 @@ package POE::Wheel::ListenAccept;
use strict;
use Carp;
-use POSIX qw(EAGAIN);
+use Symbol;
+
+use POSIX qw(fcntl_h errno_h);
use POE;
sub CRIMSON_SCOPE_HACK ($) { 0 }
@@ -18,19 +20,18 @@ sub new {
croak "wheels no longer require a kernel reference as their first parameter"
if (@_ && (ref($_[0]) eq 'POE::Kernel'));
- croak "$type requires a working Kernel"
- unless (defined $poe_kernel);
+ croak "$type requires a working Kernel" unless defined $poe_kernel;
- croak "Handle required" unless (exists $params{'Handle'});
- croak "AcceptState required" unless (exists $params{'AcceptState'});
+ croak "Handle required" unless exists $params{Handle};
+ croak "AcceptState required" unless exists $params{AcceptState};
- my $self = bless { 'handle' => $params{'Handle'},
- 'event accept' => $params{'AcceptState'},
- 'event error' => $params{'ErrorState'},
+ my $self = bless { handle => $params{Handle},
+ event_accept => $params{AcceptState},
+ event_error => $params{ErrorState},
}, $type;
# register private event handlers
$self->_define_accept_state();
- $poe_kernel->select($self->{'handle'}, $self->{'state read'});
+ $poe_kernel->select($self->{handle}, $self->{state_accept});
$self;
}
@@ -46,14 +47,14 @@ sub event {
if ($name eq 'AcceptState') {
if (defined $event) {
- $self->{'event accept'} = $event;
+ $self->{event_accept} = $event;
}
else {
carp "AcceptState requires an event name. ignoring undef";
}
}
elsif ($name eq 'ErrorState') {
- $self->{'event error'} = $event;
+ $self->{event_error} = $event;
}
else {
carp "ignoring unknown ListenAccept parameter '$name'";
@@ -68,24 +69,26 @@ sub event {
sub _define_accept_state {
my $self = shift;
# stupid closure trick
- my $event_accept = \$self->{'event accept'};
- my $event_error = \$self->{'event error'};
+ my $event_accept = \$self->{event_accept};
+ my $event_error = \$self->{event_error};
my $handle = $self->{handle};
# register the select-read handler
$poe_kernel->state
- ( $self->{'state read'} = $self . ' select read',
+ ( $self->{state_accept} = $self . ' select read',
sub {
- # prevents SEGV
+ # prevents SEGV
0 && CRIMSON_SCOPE_HACK('<');
- # subroutine starts here
+
+ # subroutine starts here
my ($k, $me, $handle) = @_[KERNEL, SESSION, ARG0];
- my $new_socket = $handle->accept();
+ my $new_socket = gensym;
+ my $peer = accept($new_socket, $handle);
- if ($new_socket) {
+ if ($peer) {
$k->call($me, $$event_accept, $new_socket);
}
- elsif ($! != EAGAIN) {
+ elsif ($! != EWOULDBLOCK) {
$$event_error &&
$k->call($me, $$event_error, 'accept', ($!+0), $!);
}
@@ -98,11 +101,11 @@ sub _define_accept_state {
sub DESTROY {
my $self = shift;
# remove tentacles from our owner
- $poe_kernel->select($self->{'handle'});
+ $poe_kernel->select($self->{handle});
- if ($self->{'state read'}) {
- $poe_kernel->state($self->{'state read'});
- delete $self->{'state read'};
+ if ($self->{state_accept}) {
+ $poe_kernel->state($self->{state_accept});
+ delete $self->{state_accept};
}
}
View
102 mylib/TestPipe.pm
@@ -0,0 +1,102 @@
+# Make pipes in a portable way.
+# $Id$
+
+package TestPipe;
+use strict;
+use Symbol qw(gensym);
+use IO::Socket;
+
+sub DEBUG () { 0 }
+
+sub new {
+ my $type = shift;
+
+ # Every one of these pipes has two ends, and the ends have read and
+ # write handles. These are bidirectional.
+ my $a_read = gensym();
+ my $a_write = gensym();
+ my $b_read = gensym();
+ my $b_write = gensym();
+
+ # The order of ways we try to make pipes is dictated by testing need
+ # rather than any sort of efficiency. My OS/2 machine supports
+ # pipes but not socketpair; my FreeBSD machine supports both.
+
+ # Try socketpair in the UNIX domain.
+ eval {
+ die "socketpair failed" unless
+ socketpair($a_read, $b_read, AF_UNIX, SOCK_STREAM, PF_UNSPEC);
+ open($a_write, "+<&=" . fileno($a_read)) or die "dup failed";
+ open($b_write, "+<&=" . fileno($b_read)) or die "dup failed";
+ };
+
+ unless (length $@) {
+ DEBUG and warn "using UNIX socketpair\n";
+ return($a_read, $a_write, $b_read, $b_write);
+ }
+
+ # Try socketpair in the INET domain.
+ eval {
+ my $tcp_proto = getprotobyname('tcp') or die "getprotobyname failed";
+ die "socketpair failed" unless
+ socketpair($a_read, $b_read, AF_INET, SOCK_STREAM, $tcp_proto);
+ open($a_write, "+<&=" . fileno($a_read)) or die "dup failed";
+ open($b_write, "+<&=" . fileno($b_read)) or die "dup failed";
+ };
+
+ unless (length $@) {
+ DEBUG and warn "using INET socketpair\n";
+ return($a_read, $a_write, $b_read, $b_write);
+ }
+
+ # Try a pair of pipes. Avoid doing this on systems that don't
+ # support non-blocking pipes.
+ if ($^O ne 'MSWin32') {
+ eval {
+ pipe($a_read, $b_write) or die "pipe failed";
+ pipe($b_read, $a_write) or die "pipe failed";
+ };
+
+ unless (length $@) {
+ DEBUG and warn "using a pair of pipes\n";
+ return($a_read, $a_write, $b_read, $b_write);
+ }
+ }
+
+ # Try traditional INET domain sockets.
+ my $old_sig_alarm = $SIG{ALRM};
+ eval {
+ local $SIG{ALRM} = sub { die "deadlock" };
+ alarm(5);
+
+ my $acceptor = IO::Socket::INET->new
+ ( LocalAddr => '127.0.0.1',
+ LocalPort => 31415,
+ Listen => 5,
+ Reuse => 'yes',
+ );
+
+ $a_read = IO::Socket::INET->new
+ ( PeerAddr => '127.0.0.1',
+ PeerPort => 31415,
+ Reuse => 'yes',
+ );
+
+ $b_read = $acceptor->accept() or die "accept";
+
+ open($a_write, "+<&=" . fileno($a_read)) or die "dup failed";
+ open($b_write, "+<&=" . fileno($b_read)) or die "dup failed";
+ };
+ alarm(0);
+ $SIG{ALRM} = $old_sig_alarm;
+
+ unless (length $@) {
+ DEBUG and warn "using a plain INET socket";
+ return($a_read, $a_write, $b_read, $b_write);
+ }
+
+ # There's nothing left to try.
+ return(undef, undef, undef, undef);
+}
+
+1;
View
30 tests/04_selects.t
@@ -6,15 +6,15 @@
use strict;
use lib qw(./lib ../lib);
use TestSetup;
+use TestPipe;
+
&test_setup(23);
# Turn on all asserts.
+# sub POE::Kernel::TRACE_DEFAULT () { 1 }
sub POE::Kernel::ASSERT_DEFAULT () { 1 }
use POE;
-use Socket;
-use Symbol qw(gensym);
-
### Test parameters.
my $pair_count = 10;
@@ -40,18 +40,16 @@ sub master_start {
$test_index *= 2;
- # Create a pair of pipes.
- my ($downlink_read, $downlink_write) = (gensym, gensym);
- pipe($downlink_read, $downlink_write)
- or die "cannot create downlink pipe: $!";
+ my ($master_read, $master_write, $slave_read, $slave_write) =
+ TestPipe->new();
- # Create a pair of pipes.
- my ($uplink_read, $uplink_write) = (gensym, gensym);
- pipe($uplink_read, $uplink_write)
- or die "cannot create uplink pipe: $!";
+ unless (defined $master_read) {
+ $test_results[$test_index] = $test_results[$test_index + 1] = undef;
+ return;
+ }
# Listen on the uplink_read side.
- $kernel->select_read($uplink_read, 'input');
+ $kernel->select_read($master_read, 'input');
# Give the other side to a newly spawned session.
POE::Session->create
@@ -61,17 +59,17 @@ sub master_start {
input => \&slave_got_input,
output => \&slave_put_output,
},
- args => [ $downlink_read, $uplink_write, $test_index + 1 ],
+ args => [ $slave_read, $slave_write, $test_index + 1 ],
);
# Save some values for later.
- $heap->{write} = $downlink_write;
+ $heap->{write} = $master_write;
$heap->{test_index} = $test_index;
$heap->{test_count} = 0;
$heap->{queue} = [ ];
# Start the write thing.
- $kernel->select_write($downlink_write, 'output');
+ $kernel->select_write($master_write, 'output');
}
sub master_stop {
@@ -86,7 +84,6 @@ sub master_got_input {
my $received = sysread($handle, my $buffer = '', 4);
unless ($received == 4) {
-die;
$kernel->select_read($handle);
$kernel->select_write($heap->{write});
return;
@@ -154,7 +151,6 @@ sub slave_got_input {
my $received = sysread($handle, my $buffer = '', 4);
unless ($received == 4) {
-die;
$kernel->select_read($handle);
$kernel->select_write($heap->{write});
return;
View
21 tests/06_tk.t
@@ -13,6 +13,7 @@ use lib '/usr/mysrc/Tk800.021/blib/arch';
use Symbol;
use TestSetup;
+use TestPipe;
# Skip if Tk isn't here.
BEGIN {
@@ -27,7 +28,7 @@ BEGIN {
unless (exists $INC{'Tk.pm'}) {
&test_setup(0, 'the Tk module is not installed');
}
-}
+};
&test_setup(8);
@@ -64,27 +65,17 @@ sub io_start {
# A pipe.
- $heap->{pipe_read} = gensym();
- $heap->{pipe_write} = gensym();
-
- eval {
- pipe($heap->{pipe_read}, $heap->{pipe_write})
- or die "can't create pipe: $!";
- };
-
- # Can't test file events.
-
- if ($@ ne '') {
+ my ($a_read, $a_write, $b_read, $b_write) = TestPipe->new();
+ unless (defined $a_read) {
print "skip 2 # $@\n";
}
-
else {
# The wheel uses read and write file events internally, so they're
# tested here.
$heap->{pipe_wheel} =
POE::Wheel::ReadWrite->new
- ( InputHandle => $heap->{pipe_read},
- OutputHandle => $heap->{pipe_write},
+ ( InputHandle => $heap->{pipe_read} = $a_read,
+ OutputHandle => $heap->{pipe_write} = $b_write,
Filter => POE::Filter::Line->new(),
Driver => POE::Driver::SysRW->new(),
InputState => 'ev_pipe_read',
View
21 tests/07_event.t
@@ -9,6 +9,7 @@ use lib qw(./lib ../lib);
use Symbol;
use TestSetup;
+use TestPipe;
# Skip if Event isn't here.
BEGIN {
@@ -16,7 +17,7 @@ BEGIN {
unless (exists $INC{'Event.pm'}) {
&test_setup(0, 'the Event module is not installed');
}
-}
+};
&test_setup(6);
@@ -34,27 +35,17 @@ sub io_start {
# A pipe.
- $heap->{pipe_read} = gensym();
- $heap->{pipe_write} = gensym();
-
- eval {
- pipe($heap->{pipe_read}, $heap->{pipe_write})
- or die "can't create pipe: $!";
- };
-
- # Can't test file events.
-
- if ($@ ne '') {
+ my ($a_read, $a_write, $b_read, $b_write) = TestPipe->new();
+ unless (defined $a_read) {
print "skip 2 # $@\n";
}
-
else {
# The wheel uses read and write file events internall, so they're
# tested here.
$heap->{pipe_wheel} =
POE::Wheel::ReadWrite->new
- ( InputHandle => $heap->{pipe_read},
- OutputHandle => $heap->{pipe_write},
+ ( InputHandle => $heap->{pipe_read} = $a_read,
+ OutputHandle => $heap->{pipe_write} = $b_write,
Filter => POE::Filter::Line->new(),
Driver => POE::Driver::SysRW->new(),
InputState => 'ev_pipe_read',
View
43 tests/19_filterchange.t
@@ -6,10 +6,9 @@
use strict;
use lib qw(./lib ../lib);
-use Symbol qw(gensym);
-use Socket;
use TestSetup qw(ok not_ok results test_setup ok_if many_not_ok);
+use TestPipe;
sub DEBUG () { 0 }
@@ -24,43 +23,9 @@ use POE qw( Wheel::ReadWrite Driver::SysRW
# will be tested on my test platforms.
# Socketpair. Read and write handles are the same.
-my $master_read = gensym();
-my $master_write = gensym();
-my $slave_read = gensym();
-my $slave_write = gensym();
-
-# Try socketpair in the UNIX domain.
-eval {
- die "socketpair failed" unless
- socketpair($master_read, $slave_read, AF_UNIX, SOCK_STREAM, PF_UNSPEC);
- open($master_write, "+<&=" . fileno($master_read)) or die "dup failed";
- open($slave_write , "+<&=" . fileno($slave_read) ) or die "dup failed";
- DEBUG and warn "using UNIX socketpair\n";
-};
-
-# Try it in the INET domain, if it failed in the UNIX domain.
-if (length $@) {
- eval {
- my $tcp_proto = getprotobyname('tcp') or die "getprotobyname failed";
- die "socketpair failed" unless
- socketpair($master_read, $slave_read, AF_INET, SOCK_STREAM, $tcp_proto);
- open($master_write, "+<&=" . fileno($master_read)) or die "dup failed";
- open($slave_write, "+<&=" . fileno($slave_read) ) or die "dup failed";
- DEBUG and warn "using INET socketpair\n";
- };
-}
-
-# Try pipe if socketpair refuses to work.
-if (length $@) {
- eval {
- die "pipe failed" unless pipe($master_read, $slave_write );
- die "pipe failed" unless pipe($slave_read, $master_write);
- DEBUG and warn "using a pair of pipes\n";
- };
-
- if (length $@) {
- &test_setup(0, "neither socketpair nor pipe worked");
- }
+my ($master_read, $master_write, $slave_read, $slave_write) = TestPipe->new();
+unless (defined $master_read) {
+ &test_setup(0, "could not create a pipe in any form");
}
# Set up tests, and go.
View
111 tests/20_accept.t
@@ -0,0 +1,111 @@
+#!/usr/bin/perl -w
+# $Id$
+
+# Exercises the ListenAccept wheel.
+
+use strict;
+use lib qw(./lib ../lib);
+use IO::Socket;
+
+use TestSetup qw(ok not_ok ok_if results test_setup many_not_ok);
+
+sub POE::Kernel::ASSERT_DEFAULT () { 1 }
+use POE qw(Wheel::ListenAccept Wheel::SocketFactory);
+
+&test_setup(4);
+
+### A listening session.
+sub listener_start {
+ my $heap = $_[HEAP];
+
+ my $listening_socket = IO::Socket::INET->new
+ ( LocalPort => 14195, # some random port
+ Listen => 5,
+ Proto => 'tcp',
+ Reuse => 'yes',
+ );
+
+ if (defined $listening_socket) {
+ &ok(2);
+ }
+ else {
+ &not_ok(2);
+ &not_ok(3);
+ return;
+ }
+
+ $heap->{listener_wheel} = POE::Wheel::ListenAccept->new
+ ( Handle => $listening_socket,
+ AcceptState => 'got_connection',
+ ErrorState => 'got_error'
+ );
+
+ $heap->{accept_count} = 0;
+ $_[KERNEL]->delay( got_timeout => 15 );
+}
+
+sub listener_stop {
+ &ok_if(3, $_[HEAP]->{accept_count} == 5);
+}
+
+sub listener_got_connection {
+ $_[HEAP]->{accept_count}++;
+ $_[KERNEL]->delay( got_timeout => 3 );
+}
+
+sub listener_got_error {
+ delete $_[HEAP]->{listener_wheel};
+}
+
+sub listener_got_timeout {
+ delete $_[HEAP]->{listener_wheel};
+}
+
+### A connecting session.
+sub connector_start {
+ $_[HEAP]->{connector_wheel} = POE::Wheel::SocketFactory->new
+ ( RemoteAddress => '127.0.0.1',
+ RemotePort => 14195,
+ SuccessState => 'got_connection',
+ FailureState => 'got_error',
+ );
+}
+
+sub connector_got_connection {
+ delete $_[HEAP]->{connector_wheel};
+}
+
+sub connector_got_error {
+ delete $_[HEAP]->{connector_wheel};
+}
+
+### Main loop.
+
+&ok(1);
+
+POE::Session->create
+ ( inline_states =>
+ { _start => \&listener_start,
+ _stop => \&listener_stop,
+ got_connection => \&listener_got_connection,
+ got_error => \&listener_got_error,
+ got_timeout => \&listener_got_timeout,
+ }
+ );
+
+for (my $connector_count=0; $connector_count < 5; $connector_count++) {
+ POE::Session->create
+ ( inline_states =>
+ { _start => \&connector_start,
+ got_connection => \&connector_got_connection,
+ got_error => \&connector_got_error,
+ }
+ );
+}
+
+$poe_kernel->run();
+
+&ok(4);
+&results();
+
+exit;
Please sign in to comment.
Something went wrong with that request. Please try again.