Skip to content

Commit

Permalink
Neyuki discovered that detach_myself() was not working from _start,
Browse files Browse the repository at this point in the history 
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
@rcaputo
rcaputo committed Nov 13, 2003
1 parent fc98a37 commit fdcdbbc
Show file tree
Hide file tree
Showing 3 changed files with 187 additions and 55 deletions.
1 change: 1 addition & 0 deletions MANIFEST
View file
Expand Up @@ -141,6 +141,7 @@ t/26_comp_tcp.t
t/27_poll.t t/27_poll.t
t/28_windows.t t/28_windows.t
t/29_sockfact6.t t/29_sockfact6.t
t/regress/neyuki-detach.t
t/res/aliases.t t/res/aliases.t
t/res/events.t t/res/events.t
t/res/extrefs.t t/res/extrefs.t
Expand Down
121 changes: 66 additions & 55 deletions lib/POE/Kernel.pm
View file
Expand Up @@ -660,18 +660,11 @@ sub _dispatch_event {


unless ($type & (ET_USER | ET_CALL)) { 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 # A "select" event has just come out of the queue. Reset its
# actual state to its requested state before handling the event. # 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); $self->_data_handle_resume_requested_state(@$etc);
} }


Expand Down Expand Up @@ -717,11 +710,11 @@ sub _dispatch_event {
# is departing. # is departing.


if (defined $parent) { if (defined $parent) {
$self->_dispatch_event $self->_dispatch_event(
( $parent, $self, $parent, $self,
EN_CHILD, ET_CHILD, [ CHILD_LOSE, $session ], EN_CHILD, ET_CHILD, [ CHILD_LOSE, $session ],
$file, $line, time(), -__LINE__ $file, $line, time(), -__LINE__
); );
} }
} }


Expand Down Expand Up @@ -907,22 +900,10 @@ sub _dispatch_event {
if $self->_data_ses_exists($session); 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 # This session has stopped. Clean up after it. There's no
# garbage collection necessary since the session's stopped. # garbage collection necessary since the session's stopped.


elsif ($type & ET_STOP) { if ($type & ET_STOP) {
$self->_data_ses_free($session); $self->_data_ses_free($session);
} }


Expand Down Expand Up @@ -1190,21 +1171,45 @@ sub session_alloc {
# Register that a session was created. # Register that a session was created.
$kr_run_warning |= KR_RUN_SESSION; $kr_run_warning |= KR_RUN_SESSION;


$self->_dispatch_event # Allocate the session's data structure. This must be done before
( $session, $kr_active_session, # we dispatch anything regarding the new session.
EN_START, ET_START, \@args, my $new_sid = $self->_data_sid_allocate();
__FILE__, __LINE__, time(), -__LINE__ $self->_data_ses_allocate($session, $new_sid, $kr_active_session);
);
$self->_data_ev_enqueue # Tell the new session that it has been created. Catch the _start
( $session, $kr_active_session, EN_GC, ET_GC, [], # state's return value so we can pass it to the parent with the
__FILE__, __LINE__, time(), # _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 # Detach a session from its parent. This breaks the parent/child
# relationship between the current session and its parent. Basically, # relationship between the current session and its parent. Basically,
# the current session is given to the Kernel session. Unlike with # the current session is given to the Kernel session. Unlike with
# _stop, the current session's children follow their parent. # _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 { sub detach_myself {
my $self = shift; my $self = shift;
Expand All @@ -1218,25 +1223,28 @@ sub detach_myself {
my $old_parent = $self->_data_ses_get_parent($kr_active_session); my $old_parent = $self->_data_ses_get_parent($kr_active_session);


# Tell the old parent session that the child is departing. # Tell the old parent session that the child is departing.
$self->_dispatch_event $self->_dispatch_event(
( $old_parent, $self, $old_parent, $self,
EN_CHILD, ET_CHILD, [ CHILD_LOSE, $kr_active_session ], EN_CHILD, ET_CHILD, [ CHILD_LOSE, $kr_active_session ],
(caller)[1,2], time(), -__LINE__ (caller)[1,2], time(), -__LINE__
); );


# Tell the new parent (kernel) that it's gaining a child. # 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 # (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.) # where the code would go if it ever does in the future.)


# Tell the current session that its parentage is changing. # Tell the current session that its parentage is changing.
$self->_dispatch_event $self->_dispatch_event(
( $kr_active_session, $self, $kr_active_session, $self,
EN_PARENT, ET_PARENT, [ $old_parent, $self ], EN_PARENT, ET_PARENT, [ $old_parent, $self ],
(caller)[1,2], time(), -__LINE__ (caller)[1,2], time(), -__LINE__
); );


$self->_data_ses_move_child($kr_active_session, $self); $self->_data_ses_move_child($kr_active_session, $self);


# Test the old parent for garbage.
$self->_data_ses_collect_garbage($old_parent);

# Success! # Success!
return 1; return 1;
} }
Expand Down Expand Up @@ -1267,25 +1275,28 @@ sub detach_child {
} }


# Tell the current session that the child is departing. # Tell the current session that the child is departing.
$self->_dispatch_event $self->_dispatch_event(
( $kr_active_session, $self, $kr_active_session, $self,
EN_CHILD, ET_CHILD, [ CHILD_LOSE, $child_session ], EN_CHILD, ET_CHILD, [ CHILD_LOSE, $child_session ],
(caller)[1,2], time(), -__LINE__ (caller)[1,2], time(), -__LINE__
); );


# Tell the new parent (kernel) that it's gaining a child. # 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 # (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.) # where the code would go if it ever does in the future.)


# Tell the child session that its parentage is changing. # Tell the child session that its parentage is changing.
$self->_dispatch_event $self->_dispatch_event(
( $child_session, $self, $child_session, $self,
EN_PARENT, ET_PARENT, [ $kr_active_session, $self ], EN_PARENT, ET_PARENT, [ $kr_active_session, $self ],
(caller)[1,2], time(), -__LINE__ (caller)[1,2], time(), -__LINE__
); );


$self->_data_ses_move_child($child_session, $self); $self->_data_ses_move_child($child_session, $self);


# Test the old parent for garbage.
$self->_data_ses_collect_garbage($kr_active_session);

# Success! # Success!
return 1; return 1;
} }
Expand Down
120 changes: 120 additions & 0 deletions tests/regress/neyuki-detach.t
View file
@@ -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.