Harness.pm 2.42 KB
Newer Older
Kevin Tew's avatar
Kevin Tew committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
package TAP::Parser::Iterator::StdOutErr;
use strict;
use warnings;
use vars qw($VERSION @ISA);

use TAP::Parser::Iterator::Process ();
use IO::Select;

@ISA = 'TAP::Parser::Iterator::Process';

sub _initialize {
    my $self = shift;
    $self->{out}        = shift || die "Need out";
    $self->{err}        = shift || die "Need err";
    $self->{sel}        = IO::Select->new( $self->{out}, $self->{err} );
    $self->{pid}        = shift || die "Need pid";
    $self->{exit}       = undef;
    $self->{chunk_size} = 65536;
    return $self;
}

package TestBed::Harness;
23 24 25 26 27 28
use SemiModern::Perl;
use TAP::Harness;
require Exporter;
our @ISA = qw(Exporter TAP::Harness);
our @EXPORT = qw(runharness);
use TestBed::TestSuite;
Kevin Tew's avatar
Kevin Tew committed
29 30 31 32 33 34 35 36
use TestBed::ForkFramework;
use TestBed::ParallelRunner;

sub build_TAP_stream {
  use TestBed::TestSuite;
  my ($in, $out, $err, $pid) = TestBed::ForkFramework::fork_child_redir(sub { TestBed::ParallelRunner::GlobalRunner->runtests; });
  return TAP::Parser::Iterator::StdOutErr->new($out, $err, $pid);
}
37 38 39 40 41 42 43

sub parser_args_callback {
  my $args = shift;
  my $ref = $args->{source};
  
  if (ref $ref and $ref->isa('TestBed::ParallelRunner')) {
    delete $args->{source};
Kevin Tew's avatar
Kevin Tew committed
44
    $args->{'stream'} = build_TAP_stream;
45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
  }
  $args;
}

sub split_t_pm {
  my @t;
  my @pm;
  map {
    if (/\.pm$/) { push @pm, glob($_); }
    elsif (/\.t$/) { push @t, glob($_); }
  } @_;
  (\@t, \@pm);
}

sub runharness {
  my @parts = my ($ts, $pms) = split_t_pm(@_);
61 62 63 64
  for (@$pms) { 
    eval "require \'$_\';"; 
    die $@ if $@;
  }
65 66 67 68 69 70 71 72

  my %harness_args = (
      verbosity => 1,
      lib     => [ '.', 'lib', 'blib/lib' ],
      );

  my $harness = TAP::Harness->new( \%harness_args );
  $harness->callback('parser_args', \&parser_args_callback);
73
  push @$ts, [TestBed::ParallelRunner->new(), 'Parallel Tests'] if @$pms;
74 75 76
  $harness->runtests(@$ts);
}

Kevin Tew's avatar
Kevin Tew committed
77

78 79 80 81 82 83
=head1 NAME

TestBed::Harness

=over 4

Kevin Tew's avatar
Kevin Tew committed
84 85 86 87
=item C<< build_TAP_stream >>

given a TestBed::ParallelRunner returns a TAP stream

88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106
=item C<< runharness(@test_file_names) >>

ex. runharness( 't/lib/*.t', 't/xmlrpc/*.t' 'test/BasicTopologies.pm' ) 

runs the specified test in a TAP::harness
pushes a ParallelRunner on if .pm parallel test modules are specified

=item C<< split_t_pm(@test_file_names) >>

splits test filenames into to lists based on .t and .pm extensions

=item C<< parser_args_callback >>

TAP::Harness parser_args callback that allow for special processing (pre_running) of parallel tests

=back

=cut

107
1;