t/02.stdout.t

   1 use Test::More no_plan => 1;
   2 use Test::Builder;
   3 use Test::MooseX::Daemonize;
   4
   5 my $Test = Test::Builder->new;
   6 chdir 't' if ( Cwd::cwd() !~ m|/t$| );
   7 my $cwd = Cwd::cwd();
   8
   9 my $file = join( '/', $cwd, 'results' );
  10
  11 {
  12
  13     package TestOutput;
  14     use Moose;
  15     with qw(MooseX::Daemonize);
  16     with qw(Test::MooseX::Daemonize::Testable); # setup our test environment
  17
  18     has max => ( isa => 'Int', is => 'ro', default => sub { 5 } );
  19
  20     after start => sub {
  21         my ($self) = @_;
  22         $self->output_ok(1);
  23     };
  24
  25     sub output_ok {
  26         my ( $self, $count ) = @_;
  27         $Test->ok( $count, "$count output_ok" );
  28         if ( $count++ > $self->max ) {
  29             $self->stop();
  30             return;
  31         }
  32         $self->output_ok($count);
  33     }
  34     no Moose;
  35 }
  36
  37 package main;
  38 use Cwd;
  39
  40 ## Try to make sure we are in the test directory
  41 chdir 't' if ( Cwd::cwd() !~ m|/t$| );
  42 my $cwd = Cwd::cwd();
  43
  44 my $daemon = TestOutput->new( pidbase => $cwd, test_output => $file);
  45
  46 daemonize_ok( $daemon, 'child forked okay' );
  47
  48 open (my $stdout_in, '<', 'results');
  49 while ( my $line = <$stdout_in> ) {
  50     $line =~ s/\s+\z//;
  51     if ( $line =~ /\A((not\s+)?ok)(?:\s+-)(?:\s+(.*))\z/ ) {
  52         my ( $status, $not, $text ) = ( $1, $2, $3 );
  53         $text ||= '';
  54
  55         # We don't just call ok(!$not), because that generates diagnostics of
  56         # its own for failures. We only want the diagnostics from the child.
  57         my $num = $Test->current_test;
  58         $Test->current_test( ++$num );
  59         $Test->_print("$status $num - $label: $text\n");
  60     }
  61     elsif ( $line =~ s/\A#\s?// ) {
  62         $Test->diag($line);
  63     }
  64     else {
  65         $Test->_print_diag("$label: $line (unrecognised)\n");
  66     }
  67 }
  68
  69 unlink($file);