From: Chris Prather Date: Mon, 21 May 2007 20:35:57 +0000 (+0000) Subject: new Test::MX::D::Testable role for subclassing children with (see t/02) X-Git-Tag: 0.01~7 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3c3db18cb8874d075ad834a5a473b13cab751350;p=gitmo%2FMooseX-Daemonize.git new Test::MX::D::Testable role for subclassing children with (see t/02) --- diff --git a/lib/Test/MooseX/Daemonize.pm b/lib/Test/MooseX/Daemonize.pm index 6160c65..33033ab 100644 --- a/lib/Test/MooseX/Daemonize.pm +++ b/lib/Test/MooseX/Daemonize.pm @@ -1,6 +1,6 @@ -package Test::MooseX::Daemonize; use strict; -use Test::More; + +package Test::MooseX::Daemonize; use Proc::Daemon; # BEGIN CARGO CULTING @@ -28,11 +28,36 @@ sub daemonize_ok { } else { sleep(5); # Punt on sleep time, 5 seconds should be enough - $Test->ok( kill 0 => $pid or $!{EPERM}, $msg ); + $Test->ok( kill(0 => $pid or $!{EPERM}), $msg ); return $pid; } } +package Test::MooseX::Daemonize::Testable; +use Moose::Role; + +has test_output => ( + isa => 'Str', + is => 'ro', + required => 1, +); + +after daemonize => sub { + $Test->use_numbers(0); + $Test->no_ending(1); + open my $stdout_out, '>', $_[0]->test_output; + my $fileno = fileno $stdout_out; + open STDERR, ">&=$fileno" + or die "Can't redirect STDERR"; + + open STDOUT, ">&=$fileno" + or die "Can't redirect STDOUT"; + + $Test->output($stdout_out); + $Test->failure_output($stdout_out); + $Test->todo_output($stdout_out); +}; + 1; __END__ diff --git a/t/02.stdout.t b/t/02.stdout.t new file mode 100644 index 0000000..dcf2706 --- /dev/null +++ b/t/02.stdout.t @@ -0,0 +1,69 @@ +use Test::More no_plan => 1; +use Test::Builder; +use Test::MooseX::Daemonize; + +my $Test = Test::Builder->new; +chdir 't' if ( Cwd::cwd() !~ m|/t$| ); +my $cwd = Cwd::cwd(); + +my $file = join( '/', $cwd, 'results' ); + +{ + + package TestOutput; + use Moose; + with qw(MooseX::Daemonize); + with qw(Test::MooseX::Daemonize::Testable); # setup our test environment + + has max => ( isa => 'Int', is => 'ro', default => sub { 5 } ); + + after start => sub { + my ($self) = @_; + $self->output_ok(1); + }; + + sub output_ok { + my ( $self, $count ) = @_; + $Test->ok( $count, "$count output_ok" ); + if ( $count++ > $self->max ) { + $self->stop(); + return; + } + $self->output_ok($count); + } + no Moose; +} + +package main; +use Cwd; + +## Try to make sure we are in the test directory +chdir 't' if ( Cwd::cwd() !~ m|/t$| ); +my $cwd = Cwd::cwd(); + +my $daemon = TestOutput->new( pidbase => $cwd, test_output => $file); + +daemonize_ok( $daemon, 'child forked okay' ); + +open (my $stdout_in, '<', 'results'); +while ( my $line = <$stdout_in> ) { + $line =~ s/\s+\z//; + if ( $line =~ /\A((not\s+)?ok)(?:\s+-)(?:\s+(.*))\z/ ) { + my ( $status, $not, $text ) = ( $1, $2, $3 ); + $text ||= ''; + + # We don't just call ok(!$not), because that generates diagnostics of + # its own for failures. We only want the diagnostics from the child. + my $num = $Test->current_test; + $Test->current_test( ++$num ); + $Test->_print("$status $num - $label: $text\n"); + } + elsif ( $line =~ s/\A#\s?// ) { + $Test->diag($line); + } + else { + $Test->_print_diag("$label: $line (unrecognised)\n"); + } +} + +unlink($file); \ No newline at end of file