Permalink
Browse files

Neyuki discovered that detach_myself() was not working from _start,

nor was it working at all.  This commit fixes the latter problem, but
detach_myself() from _start is not completely fixed.  Turned the test
case into a regression test, and started t/regress for these things.
  • Loading branch information...
1 parent fc98a37 commit fdcdbbcda35e2ee2180bace75dcf8b8a022ea1d4 @rcaputo committed Nov 13, 2003
Showing with 187 additions and 55 deletions.
  1. +1 −0 MANIFEST
  2. +66 −55 lib/POE/Kernel.pm
  3. +120 −0 tests/regress/neyuki-detach.t
View
@@ -141,6 +141,7 @@ t/26_comp_tcp.t
t/27_poll.t
t/28_windows.t
t/29_sockfact6.t
+t/regress/neyuki-detach.t
t/res/aliases.t
t/res/events.t
t/res/extrefs.t
View
@@ -660,18 +660,11 @@ sub _dispatch_event {
unless ($type & (ET_USER | ET_CALL)) {
- # The _start event is dispatched immediately as part of allocating
- # a session. Set up the kernel's tables for this session.
-
- if ($type & ET_START) {
- my $sid = $self->_data_sid_allocate();
- $self->_data_ses_allocate($session, $sid, $source_session);
- }
# A "select" event has just come out of the queue. Reset its
# actual state to its requested state before handling the event.
- elsif ($type & ET_SELECT) {
+ if ($type & ET_SELECT) {
$self->_data_handle_resume_requested_state(@$etc);
}
@@ -717,11 +710,11 @@ sub _dispatch_event {
# is departing.
if (defined $parent) {
- $self->_dispatch_event
- ( $parent, $self,
- EN_CHILD, ET_CHILD, [ CHILD_LOSE, $session ],
- $file, $line, time(), -__LINE__
- );
+ $self->_dispatch_event(
+ $parent, $self,
+ EN_CHILD, ET_CHILD, [ CHILD_LOSE, $session ],
+ $file, $line, time(), -__LINE__
+ );
}
}
@@ -907,22 +900,10 @@ sub _dispatch_event {
if $self->_data_ses_exists($session);
}
- # A new session has started. Tell its parent. Incidental _start
- # events are fired after the dispatch. Garbage collection is
- # delayed until ET_GC.
-
- if ($type & ET_START) {
- $self->_dispatch_event
- ( $self->_data_ses_get_parent($session), $self,
- EN_CHILD, ET_CHILD, [ CHILD_CREATE, $session, $return ],
- $file, $line, time(), -__LINE__
- );
- }
-
# This session has stopped. Clean up after it. There's no
# garbage collection necessary since the session's stopped.
- elsif ($type & ET_STOP) {
+ if ($type & ET_STOP) {
$self->_data_ses_free($session);
}
@@ -1190,21 +1171,45 @@ sub session_alloc {
# Register that a session was created.
$kr_run_warning |= KR_RUN_SESSION;
- $self->_dispatch_event
- ( $session, $kr_active_session,
- EN_START, ET_START, \@args,
- __FILE__, __LINE__, time(), -__LINE__
- );
- $self->_data_ev_enqueue
- ( $session, $kr_active_session, EN_GC, ET_GC, [],
- __FILE__, __LINE__, time(),
- );
+ # Allocate the session's data structure. This must be done before
+ # we dispatch anything regarding the new session.
+ my $new_sid = $self->_data_sid_allocate();
+ $self->_data_ses_allocate($session, $new_sid, $kr_active_session);
+
+ # Tell the new session that it has been created. Catch the _start
+ # state's return value so we can pass it to the parent with the
+ # _child create.
+ my $return = $self->_dispatch_event(
+ $session, $kr_active_session,
+ EN_START, ET_START, \@args,
+ __FILE__, __LINE__, time(), -__LINE__
+ );
+
+ # If the child has not detached itself---that is, if its parent is
+ # the currently active session---then notify the parent with a
+ # _child create event. Otherwise skip it, since we'd otherwise
+ # throw a create without a lose.
+ $self->_dispatch_event(
+ $self->_data_ses_get_parent($session), $self,
+ EN_CHILD, ET_CHILD, [ CHILD_CREATE, $session, $return ],
+ __FILE__, __LINE__, time(), -__LINE__
+ );
+
+ # Enqueue a delayed garbage-collection event so the session has time
+ # to do its thing before it goes.
+ $self->_data_ev_enqueue(
+ $session, $session, EN_GC, ET_GC, [],
+ __FILE__, __LINE__, time(),
+ );
}
# Detach a session from its parent. This breaks the parent/child
# relationship between the current session and its parent. Basically,
# the current session is given to the Kernel session. Unlike with
# _stop, the current session's children follow their parent.
+#
+# TODO - Calling detach_myself() from _start means the parent receives
+# a "_child lose" event without ever seeing "_child create".
sub detach_myself {
my $self = shift;
@@ -1218,25 +1223,28 @@ sub detach_myself {
my $old_parent = $self->_data_ses_get_parent($kr_active_session);
# Tell the old parent session that the child is departing.
- $self->_dispatch_event
- ( $old_parent, $self,
- EN_CHILD, ET_CHILD, [ CHILD_LOSE, $kr_active_session ],
- (caller)[1,2], time(), -__LINE__
- );
+ $self->_dispatch_event(
+ $old_parent, $self,
+ EN_CHILD, ET_CHILD, [ CHILD_LOSE, $kr_active_session ],
+ (caller)[1,2], time(), -__LINE__
+ );
# Tell the new parent (kernel) that it's gaining a child.
# (Actually it doesn't care, so we don't do that here, but this is
# where the code would go if it ever does in the future.)
# Tell the current session that its parentage is changing.
- $self->_dispatch_event
- ( $kr_active_session, $self,
- EN_PARENT, ET_PARENT, [ $old_parent, $self ],
- (caller)[1,2], time(), -__LINE__
- );
+ $self->_dispatch_event(
+ $kr_active_session, $self,
+ EN_PARENT, ET_PARENT, [ $old_parent, $self ],
+ (caller)[1,2], time(), -__LINE__
+ );
$self->_data_ses_move_child($kr_active_session, $self);
+ # Test the old parent for garbage.
+ $self->_data_ses_collect_garbage($old_parent);
+
# Success!
return 1;
}
@@ -1267,25 +1275,28 @@ sub detach_child {
}
# Tell the current session that the child is departing.
- $self->_dispatch_event
- ( $kr_active_session, $self,
- EN_CHILD, ET_CHILD, [ CHILD_LOSE, $child_session ],
- (caller)[1,2], time(), -__LINE__
- );
+ $self->_dispatch_event(
+ $kr_active_session, $self,
+ EN_CHILD, ET_CHILD, [ CHILD_LOSE, $child_session ],
+ (caller)[1,2], time(), -__LINE__
+ );
# Tell the new parent (kernel) that it's gaining a child.
# (Actually it doesn't care, so we don't do that here, but this is
# where the code would go if it ever does in the future.)
# Tell the child session that its parentage is changing.
- $self->_dispatch_event
- ( $child_session, $self,
- EN_PARENT, ET_PARENT, [ $kr_active_session, $self ],
- (caller)[1,2], time(), -__LINE__
- );
+ $self->_dispatch_event(
+ $child_session, $self,
+ EN_PARENT, ET_PARENT, [ $kr_active_session, $self ],
+ (caller)[1,2], time(), -__LINE__
+ );
$self->_data_ses_move_child($child_session, $self);
+ # Test the old parent for garbage.
+ $self->_data_ses_collect_garbage($kr_active_session);
+
# Success!
return 1;
}
@@ -0,0 +1,120 @@
+#!/usr/bin/perl -w
+# $Id$
+
+use strict;
+
+$| = 1;
+
+sub POE::Kernel::ASSERT_DEFAULT () { 1 }
+use POE;
+
+print "1..10\n";
+
+my $test = 0;
+
+POE::Session->create(
+ inline_states => {
+ _start => sub {
+ $test++;
+ print "not " unless $test == 1;
+ print "ok $test # starting parent\n";
+
+ $_[KERNEL]->yield('parent');
+ },
+
+ _stop => sub {
+ $test++;
+ print "not " unless $test == 8;
+ print "ok $test # stopping parent\n";
+ },
+
+ _parent => sub {
+ $test++;
+ print "not ok $test # parent received _parent\n";
+ },
+
+ _child => sub {
+
+ $test++;
+ if ($test == 4) {
+ print "not " unless (
+ $_[ARG1]->ID == 3 and
+ $_[ARG0] eq "create"
+ );
+ print "ok $test # parent should receive _child create\n";
+ return;
+ }
+
+ if ($test == 6) {
+ print "not " unless (
+ $_[ARG1]->ID == 3 and
+ $_[ARG0] eq "lose"
+ );
+ print "ok $test # parent should receive _child lose\n";
+ return;
+ }
+
+ print "not ok $test # parent received _child $_[ARG0]\n";
+ },
+
+ parent => sub {
+ $test++;
+ print "not " unless $test == 2;
+ print "ok $test # parent spawning child\n";
+
+ POE::Session->create(
+ inline_states => {
+ _start => sub {
+ $test++;
+ print "not " unless $test == 3;
+ print "ok $test # child starting\n";
+
+ $_[KERNEL]->yield('child');
+ },
+
+ _stop => sub {
+ $test++;
+ print "not " unless $test == 10;
+ print "ok $test # child stopping\n";
+ },
+
+ _parent => sub {
+ $test++;
+ if ($test == 7) {
+ print "not " unless (
+ $_[ARG0]->ID == 2 and
+ $_[ARG1]->isa("POE::Kernel")
+ );
+ print "ok $test # child should receive _parent = kernel\n";
+ return;
+ }
+
+ print "not ok $test # child given to $_[ARG1]\n";
+ },
+
+ _child => sub {
+ $test++;
+ print "not ok $test # child received _child $_[ARG0]\n";
+ },
+
+ child => sub {
+ $test++;
+ print "not " unless $test == 5;
+ print "ok $test # child detaching itself\n";
+
+ $_[KERNEL]->detach_myself;
+ $_[KERNEL]->yield("done");
+ },
+
+ done => sub {
+ $test++;
+ print "not " unless $test == 9;
+ print "ok $test # child is done\n";
+ },
+ }
+ );
+ } # parent
+ } # inline_states
+);
+
+$poe_kernel->run;

0 comments on commit fdcdbbc

Please sign in to comment.