Skip to content
Browse files

Add agorman's test for run_all() called twice, and fix the problem.

Agorman (irc.perl.org #reflex) discovered that run_all() called more
than once asplodes ugly-like.  He provided a nice test case, which
I've added to Reflex's tests.  It uses Reflex::POE::Wheel::Run, and
that might need to be removed to make the test more portable.
  • Loading branch information...
1 parent 02cbace commit 1b7423a2c48f6137ed8c01c3fe94f293a967f164 @rcaputo committed
View
2 lib/Reflex/POE/Wheel/Run.pm
@@ -85,7 +85,7 @@ sub valid_params {
# Also handle signals.
observes sigchild_watcher => (
- isa => 'Reflex::PID|Undef',
+ isa => 'Maybe[Reflex::PID]',
role => 'sigchld',
);
View
167 lib/Reflex/Role/Reactive.pm
@@ -34,108 +34,115 @@ POE::Kernel->run();
my %session_object_count;
-my $singleton_session_id = POE::Session->create(
- inline_states => {
- # Make the session conveniently accessible.
- # Although we're using the $singleton_session_id, so why bother?
-
- _start => sub {
- # No-op to satisfy assertions.
- undef;
- },
- _stop => sub {
- # No-op to satisfy assertions.
- undef;
- },
+my $singleton_session_id;
- ### Timer manipulators and callbacks.
+sub _create_singleton_session {
+ $singleton_session_id = POE::Session->create(
+ inline_states => {
+ # Make the session conveniently accessible.
+ # Although we're using the $singleton_session_id, so why bother?
- timer_due => sub {
- my $envelope = $_[ARG0];
- my ($cb_object, $cb_method) = @$envelope;
- $cb_object->$cb_method({});
- },
+ _start => sub {
+ # No-op to satisfy assertions.
+ undef;
+ },
+ _stop => sub {
+ # No-op to satisfy assertions.
+ undef;
+ },
- ### I/O manipulators and callbacks.
+ ### Timer manipulators and callbacks.
- select_ready => sub {
- my ($handle, $envelope, $mode) = @_[ARG0, ARG2];
- my ($cb_object, $cb_method) = @$envelope;
- $cb_object->$cb_method({ handle => $handle });
- },
+ timer_due => sub {
+ my $envelope = $_[ARG0];
+ my ($cb_object, $cb_method) = @$envelope;
+ $cb_object->$cb_method({});
+ },
- ### Signals.
+ ### I/O manipulators and callbacks.
- signal_happened => sub {
- my $signal_class = pop @_;
- $signal_class->deliver(@_[ARG0..$#_]);
- },
+ select_ready => sub {
+ my ($handle, $envelope, $mode) = @_[ARG0, ARG2];
+ my ($cb_object, $cb_method) = @$envelope;
+ $cb_object->$cb_method({ handle => $handle });
+ },
- ### Cross-session emit() is converted into these events.
+ ### Signals.
- deliver_callback => sub {
- my ($callback, $args) = @_[ARG0, ARG1];
- $callback->deliver($args);
- },
+ signal_happened => sub {
+ my $signal_class = pop @_;
+ $signal_class->deliver(@_[ARG0..$#_]);
+ },
- # call_gate() uses this to call methods in the right session.
+ ### Cross-session emit() is converted into these events.
- call_gate_method => sub {
- my ($object, $method, @args) = @_[ARG0..$#_];
- return $object->$method(@args);
- },
+ deliver_callback => sub {
+ my ($callback, $args) = @_[ARG0, ARG1];
+ $callback->deliver($args);
+ },
- call_gate_coderef => sub {
- my ($coderef, @args) = @_[ARG0..$#_];
- return $coderef->(@args);
- },
+ # call_gate() uses this to call methods in the right session.
- # Catch dynamic events.
+ call_gate_method => sub {
+ my ($object, $method, @args) = @_[ARG0..$#_];
+ return $object->$method(@args);
+ },
- _default => sub {
- my ($event, $args) = @_[ARG0, ARG1];
+ call_gate_coderef => sub {
+ my ($coderef, @args) = @_[ARG0..$#_];
+ return $coderef->(@args);
+ },
- return $event->deliver($args) if (
- "$event" =~ /^Reflex::POE::Event(?:::|=)/
- );
+ # Catch dynamic events.
- return if Reflex::POE::Session->deliver($_[SENDER]->ID, $event, $args);
+ _default => sub {
+ my ($event, $args) = @_[ARG0, ARG1];
- # Unhandled event.
- # TODO - Should anything special be done in this case?
- },
+ return $event->deliver($args) if (
+ "$event" =~ /^Reflex::POE::Event(?:::|=)/
+ );
- ### Support POE::Wheel classes.
+ return if Reflex::POE::Session->deliver($_[SENDER]->ID, $event, $args);
- # Deliver to wheels based on the wheel ID. Different wheels pass
- # their IDs in different ARGn offsets, so we need a few of these.
- wheel_event_0 => sub {
- $_[CALLER_FILE] =~ m{/([^/.]+)\.pm};
- "Reflex::POE::Wheel:\:$1"->deliver(0, @_[ARG0..$#_]);
- },
- wheel_event_1 => sub {
- $_[CALLER_FILE] =~ m{/([^/.]+)\.pm};
- "Reflex::POE::Wheel:\:$1"->deliver(1, @_[ARG0..$#_]);
- },
- wheel_event_2 => sub {
- $_[CALLER_FILE] =~ m{/([^/.]+)\.pm};
- "Reflex::POE::Wheel:\:$1"->deliver(2, @_[ARG0..$#_]);
- },
- wheel_event_3 => sub {
- $_[CALLER_FILE] =~ m{/([^/.]+)\.pm};
- "Reflex::POE::Wheel:\:$1"->deliver(3, @_[ARG0..$#_]);
- },
- wheel_event_4 => sub {
- $_[CALLER_FILE] =~ m{/([^/.]+)\.pm};
- "Reflex::POE::Wheel:\:$1"->deliver(4, @_[ARG0..$#_]);
+ # Unhandled event.
+ # TODO - Should anything special be done in this case?
+ },
+
+ ### Support POE::Wheel classes.
+
+ # Deliver to wheels based on the wheel ID. Different wheels pass
+ # their IDs in different ARGn offsets, so we need a few of these.
+ wheel_event_0 => sub {
+ $_[CALLER_FILE] =~ m{/([^/.]+)\.pm};
+ "Reflex::POE::Wheel:\:$1"->deliver(0, @_[ARG0..$#_]);
+ },
+ wheel_event_1 => sub {
+ $_[CALLER_FILE] =~ m{/([^/.]+)\.pm};
+ "Reflex::POE::Wheel:\:$1"->deliver(1, @_[ARG0..$#_]);
+ },
+ wheel_event_2 => sub {
+ $_[CALLER_FILE] =~ m{/([^/.]+)\.pm};
+ "Reflex::POE::Wheel:\:$1"->deliver(2, @_[ARG0..$#_]);
+ },
+ wheel_event_3 => sub {
+ $_[CALLER_FILE] =~ m{/([^/.]+)\.pm};
+ "Reflex::POE::Wheel:\:$1"->deliver(3, @_[ARG0..$#_]);
+ },
+ wheel_event_4 => sub {
+ $_[CALLER_FILE] =~ m{/([^/.]+)\.pm};
+ "Reflex::POE::Wheel:\:$1"->deliver(4, @_[ARG0..$#_]);
+ },
},
- },
-)->ID();
+ )->ID();
+}
has session_id => (
isa => 'Str',
is => 'ro',
- default => $singleton_session_id,
+ default => sub {
+ _create_singleton_session() unless defined $singleton_session_id;
+ $singleton_session_id;
+ },
);
# What's watching me.
@@ -547,6 +554,7 @@ sub call_gate {
$POE::Kernel::poe_kernel->call(
$self->session_id(), "call_gate_method", $self, $method, @_[2..$#_]
);
+
return 0;
}
@@ -575,6 +583,7 @@ sub run_within_session {
sub run_all {
POE::Kernel->run();
+ $singleton_session_id = undef;
}
sub next {
View
0 t/901-discrete-observer.t → t/101-discrete-observer.t
File renamed without changes.
View
0 t/902-observed-new.t → t/102-observed-new.t
File renamed without changes.
View
0 t/920-rcb-coderef.t → t/120-rcb-coderef.t
File renamed without changes.
View
0 t/921-rcb-method.t → t/121-rcb-method.t
File renamed without changes.
View
0 t/922-rcb-object.t → t/122-rcb-object.t
File renamed without changes.
View
0 t/923-rcb-class.t → t/123-rcb-class.t
File renamed without changes.
View
0 t/924-rcb-role.t → t/124-rcb-role.t
File renamed without changes.
View
0 t/925-rcb-promise.t → t/125-rcb-promise.t
File renamed without changes.
View
90 t/300-run-all-twice.t
@@ -0,0 +1,90 @@
+{
+ package Runner;
+ use Moose;
+ extends 'Reflex::Base';
+ use Reflex::POE::Wheel::Run;
+ use Reflex::Callbacks qw(cb_role);
+
+ use constant VERBOSE => 0;
+
+ has count => (
+ is => 'rw',
+ isa => 'ScalarRef',
+ );
+
+ has wheel => (
+ isa => 'Reflex::POE::Wheel::Run|Undef',
+ is => 'rw',
+ );
+
+ has end => (
+ isa => 'Int',
+ is => 'ro',
+ );
+
+ sub BUILD {
+ my $self = shift;
+
+ $self->wheel(
+ Reflex::POE::Wheel::Run->new(
+ Program => "$^X -wle 'print qq[pid(\$\$) moo(\$_)] for 1..".$self->end."; exit'",
+ cb_role($self, "child"),
+ )
+ );
+ }
+
+ sub on_child_stdin {
+ VERBOSE and Test::More::diag("stdin flushed");
+ }
+
+ sub on_child_stdout {
+ my ($self, $args) = @_;
+ VERBOSE and Test::More::diag("stdout: $args->{output}");
+ ${$self->count()}++;
+ }
+
+ sub on_child_stderr {
+ my ($self, $args) = @_;
+ VERBOSE and Test::More::diag("stderr: $args->{output}");
+ }
+
+ sub on_child_error {
+ my ($self, $args) = @_;
+ return if $args->{operation} eq "read";
+ VERBOSE and Test::More::diag(
+ "$args->{operation} error $args->{errnum}: $args->{errstr}"
+ );
+ }
+
+ sub on_child_close {
+ my ($self, $args) = @_;
+ VERBOSE and Test::More::diag("child closed all output");
+ }
+
+ sub on_child_signal {
+ my ($self, $args) = @_;
+ VERBOSE and Test::More::diag("child $args->{pid} exited: $args->{exit}");
+ $self->wheel(undef);
+ }
+}
+
+# Main.
+
+use Test::More tests => 2;
+
+{
+ my ($end, $count) = (1, 0);
+ my $runner = Runner->new(end => 1, count => \$count);
+ Reflex->run_all();
+ is($end, $count, "first run ran to completion");
+}
+
+{
+ my ($end, $count) = (10, 0);
+ my $runner2 = Runner->new(end => 10, count => \$count);
+ Reflex->run_all();
+ Reflex->run_all();
+ is($end, $count, "second run ran to completion");
+}
+
+exit;

0 comments on commit 1b7423a

Please sign in to comment.
Something went wrong with that request. Please try again.