package t::lib::Test;
use strict;
use Test::More;
use Exporter;
use IPC::Run qw{ harness };
use IPC::Run::IO;
use vars qw{@ISA @EXPORT};
BEGIN {
@ISA = qw{ Exporter };
@EXPORT = qw{ filter_tests };
}
## This is not needed by most users. Should really move to IPC::Run::TestUtils
#=item filter_tests
#
# my @tests = filter_tests( "foo", "in", "out", \&filter );
# $_->() for ( @tests );
#
#This creates a list of test subs that can be used to test most filters
#for basic functionality. The first parameter is the name of the
#filter to be tested, the second is sample input, the third is the
#test(s) to apply to the output(s), and the rest of the parameters are
#the filters to be linked and tested.
#
#If the filter chain is to be fed multiple inputs in sequence, the second
#parameter should be a reference to an array of thos inputs:
#
# my @tests = filter_tests( "foo", [qw(1 2 3)], "123", \&filter );
#
#If the filter chain should produce a sequence of outputs, then the
#thrid parameter should be a reference to an array of those outputs:
#
# my @tests = filter_tests(
# "foo",
# "1\n\2\n",
# [ qr/^1$/, qr/^2$/ ],
# new_chunker
# );
#
#See t/run.t and t/filter.t for an example of this in practice.
#
#=cut
##
## Filter testing routines
##
sub filter_tests($;@) {
my ( $name, $in, $exp, @filters ) = @_;
my @in = ref $in eq 'ARRAY' ? @$in : ( $in );
my @exp = ref $exp eq 'ARRAY' ? @$exp : ( $exp );
my IPC::Run::IO $op;
my $output;
my @input;
my $in_count = 0;
my @out;
my $h;
SCOPE: {
$h = harness();
$op = IPC::Run::IO->_new_internal( '<', 0, 0, 0, undef,
IPC::Run::new_string_sink( \$output ),
@filters,
IPC::Run::new_string_source( \@input ),
);
$op->_init_filters;
@input = ();
$output = '';
is(
! defined $op->_do_filters( $h ),
1,
"$name didn't pass undef (EOF) through"
);
};
## See if correctly does nothing on 0, (please try again)
SCOPE: {
$op->_init_filters;
$output = '';
@input = ( '' );
is(
$op->_do_filters( $h ),
0,
"$name didn't return 0 (please try again) when given a 0"
);
};
SCOPE: {
@input = ( '' );
is(
$op->_do_filters( $h ),
0,
"$name didn't return 0 (please try again) when given a second 0"
);
};
SCOPE: {
for (1..100) {
last unless defined $op->_do_filters( $h );
}
is(
! defined $op->_do_filters( $h ),
1,
"$name didn't return undef (EOF) after two 0s and an undef"
);
};
## See if it can take @in and make @out
SCOPE: {
$op->_init_filters;
$output = '';
@input = @in;
while ( defined $op->_do_filters( $h ) && @input ) {
if ( length $output ) {
push @out, $output;
$output = '';
}
}
if ( length $output ) {
push @out, $output;
$output = '';
}
is(
scalar @input,
0,
"$name didn't consume it's input"
);
};
SCOPE: {
for (1..100) {
last unless defined $op->_do_filters( $h );
if ( length $output ) {
push @out, $output;
$output = '';
}
}
is(
! defined $op->_do_filters( $h ),
1,
"$name didn't return undef (EOF), tried 100 times"
);
};
SCOPE: {
is(
join( ', ', map "'$_'", @out ),
join( ', ', map "'$_'", @exp ),
$name
)
};
SCOPE: {
## Force the harness to be cleaned up.
$h = undef;
ok( 1 );
};
}
1;