From: Chris Prather <chris@prather.org>
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?p=gitmo%2FMooseX-Daemonize.git;a=commitdiff_plain;h=3c3db18cb8874d075ad834a5a473b13cab751350

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