Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Add debug_long_running option

  • Loading branch information...
commit 374acb33efb77d8357715d1bd347e2b1ff45e859 1 parent 9133a01
@exodist authored
View
9 README
@@ -232,6 +232,15 @@ CONFIGURATION
Defaults to: 'rand'
+ debug_long_running => $TIMEOUT
+ This will cause a test block to abort after a specified timeout (value
+ is passed directly to alaram).
+
+ NOTE This uses the "alarm($timeout)" function. If your tests include
+ alarms the behavior is not defined. One will certainly clobber the
+ other, your will most likely come out on top, but that is not guarenteed
+ in any way. Only use this while debugging and remove it afterwords.
+
'random'
Will shuffle the order. Keep in mind Fennec sets the random seed
using the date so that tests will be determinate on the day you
View
12 lib/Fennec.pm
@@ -4,7 +4,7 @@ use warnings;
use Fennec::Util qw/inject_sub/;
-our $VERSION = '1.008';
+our $VERSION = '1.010';
our $WIN32_RELOAD = 0;
sub defaults {(
@@ -420,6 +420,16 @@ can use the shorter versions 'rand', and 'ord'.
Defaults to: 'rand'
+=head3 debug_long_running => $TIMEOUT
+
+This will cause a test block to abort after a specified timeout (value is
+passed directly to alaram).
+
+B<NOTE> This uses the C<alarm($timeout)> function. If your tests include alarms
+the behavior is not defined. One will certainly clobber the other, your will
+most likely come out on top, but that is not guarenteed in any way. Only use
+this while debugging and remove it afterwords.
+
=over 4
=item 'random'
View
3  lib/Fennec/Listener/TB.pm
@@ -100,7 +100,8 @@ sub listen {
$alarm->(0.01);
# Catch odd case were we stop reading too soon
# TODO: Figure out why it happens.
- for ( 1 .. 2 ) {
+ # OMG: This is a horrible hack!
+ for ( 1 .. 100 ) {
while( my $line = <$read> ) {
$lock = 1;
$self->handle_line( $line ) if $line;
View
2  lib/Fennec/Meta.pm
@@ -4,7 +4,7 @@ use warnings;
use Fennec::Util qw/accessors/;
-accessors qw/parallel class fennec base test_sort with_tests/;
+accessors qw/parallel class fennec base test_sort with_tests debug_long_running/;
sub new {
my $class = shift;
View
11 lib/Fennec/Runner.pm
@@ -129,6 +129,7 @@ sub run {
print "Running: $class\n";
my $instance = $class->can('new') ? $class->new : bless( {}, $class );
my $meta = $instance->TEST_WORKFLOW;
+ $meta->debug_long_running( $instance->FENNEC->debug_long_running );
my $prunner;
if ( my $max = $class->FENNEC->parallel ) {
@@ -138,8 +139,16 @@ sub run {
else {
require Parallel::Runner;
$prunner = Parallel::Runner->new( $max );
+ $prunner->reap_callback( sub {
+ my ( $status, $pid, $pid_again, $proc ) = @_;
+
+ # Status as returned from system, so 0 is good, 1+ is bad.
+ die "Child $pid did not exit 0"
+ if $status;
+ });
+
$meta->test_run( sub {
- my $sub = shift;
+ my ( $sub, $test, $obj ) = shift;
$prunner->run( sub {
$instance->TEST_WORKFLOW->test_run(undef);
$sub->();
View
2  lib/Test/Workflow/Block.pm
@@ -81,7 +81,7 @@ sub run {
$meta->todo_start->( $self->todo )
if $self->todo;
- my $success = eval { $self->code->( @_ ); 1 } || $self->should_fail;
+ my $success = eval { $self->code->( @_ ); 1 } || $self->should_fail || 0;
my $error = $@ || "Error masked!";
chomp( $error );
View
2  lib/Test/Workflow/Meta.pm
@@ -9,7 +9,7 @@ use Fennec::Util qw/accessors/;
accessors qw/
test_class build_complete root_layer test_run test_sort
- ok diag skip todo_start todo_end
+ ok diag skip todo_start todo_end debug_long_running
/;
sub new {
View
48 lib/Test/Workflow/Test.pm
@@ -4,6 +4,7 @@ use warnings;
use Fennec::Util qw/accessors/;
use List::Util qw/shuffle/;
+use Carp qw/cluck/;
accessors qw/setup tests teardown around block_name/;
@@ -27,6 +28,33 @@ sub name {
return $self->block_name;
}
+sub debug_handler {
+ my $self = shift;
+ my ( $timeout, $instance ) = @_;
+
+ my $data = {
+ instance => $instance,
+ test => $self,
+ };
+
+ return sub {
+ require Data::Dumper;
+
+ my $out = "Long running process timeout\n";
+
+ $out .= "\ttimeout - $timeout\n\ttest - " . $self->name . "\n\n";
+
+ {
+ local $Data::Dumper::Maxdepth = 3;
+ $out .= "Brief Dump: " . Data::Dumper::Dumper($data);
+ }
+
+ $out .= "Full Dump: " . Data::Dumper::Dumper($data);
+
+ die $out;
+ }
+};
+
sub run {
my $self = shift;
my ( $instance ) = @_;
@@ -35,11 +63,28 @@ sub run {
my $prunner = $instance->TEST_WORKFLOW->test_run;
my $testcount = @{ $self->tests };
- return $prunner->( $run ) if $prunner && $testcount == 1;
+ return $prunner->( $run, $self, $instance ) if $prunner && $testcount == 1;
$run->();
}
+sub _timeout_wrap {
+ my $self = shift;
+ my ( $instance, $inner ) = @_;
+
+ my $timeout = $instance->TEST_WORKFLOW->debug_long_running;
+ return $inner unless $timeout;
+
+ return sub {
+ $SIG{ALRM} = $self->debug_handler( $timeout, $instance );
+ alarm $timeout;
+ $inner->();
+ alarm 0;
+ # At this point we have screwed up any other alarms, clear the handler
+ $SIG{ALRM} = undef;
+ };
+}
+
sub _wrap_tests {
my $self = shift;
my ( $instance ) = @_;
@@ -51,6 +96,7 @@ sub _wrap_tests {
$_->run( $instance ) for @{ $self->setup };
for my $test ( @tests ) {
my $outer = sub { $test->run( $instance )};
+ $outer = $self->_timeout_wrap( $instance, $outer );
for my $around ( @{ $self->around }) {
my $inner = $outer;
$outer = sub { $around->run( $instance, $inner )};
Please sign in to comment.
Something went wrong with that request. Please try again.