Commit | Line | Data |
3c3db18c |
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); |