Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
compat	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
data	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
lib	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
proverc	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
sample-tests	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
source_tests	[ DIR ]	drwxr-xr-x	2016-10-10 18:24
subclass_tests	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
aggregator.t	9.35 KB	-r--r--r--	2014-12-27 11:48
bailout.t	3.12 KB	-r--r--r--	2014-12-27 11:48
base.t	4.68 KB	-r--r--r--	2014-12-27 11:48
callbacks.t	2.57 KB	-r--r--r--	2014-12-27 11:48
console.t	1.06 KB	-r--r--r--	2014-12-27 11:48
errors.t	4.64 KB	-r--r--r--	2014-12-27 11:48
file.t	13.61 KB	-r--r--r--	2014-12-27 11:48
glob-to-regexp.t	988 B	-r--r--r--	2014-12-27 11:48
grammar.t	11.55 KB	-r--r--r--	2014-12-27 11:48
harness-bailout.t	1.19 KB	-r--r--r--	2014-12-27 11:48
harness-subclass.t	1.58 KB	-r--r--r--	2014-12-27 11:48
harness.t	28.38 KB	-r--r--r--	2014-12-27 11:48
iterator_factory.t	4.8 KB	-r--r--r--	2014-12-27 11:48
iterators.t	5.68 KB	-r--r--r--	2014-12-27 11:48
multiplexer.t	4.53 KB	-r--r--r--	2014-12-27 11:48
nested.t	860 B	-r--r--r--	2014-12-27 11:48
nofork-mux.t	119 B	-r--r--r--	2014-12-27 11:48
nofork.t	1.55 KB	-r--r--r--	2014-12-27 11:48
object.t	772 B	-r--r--r--	2014-12-27 11:48
parse.t	30.97 KB	-r--r--r--	2014-12-27 11:48
parser-config.t	731 B	-r--r--r--	2014-12-27 11:48
parser-subclass.t	2.2 KB	-r--r--r--	2014-12-27 11:48
perl5lib.t	1.13 KB	-r--r--r--	2014-12-27 11:48
premature-bailout.t	2.32 KB	-r--r--r--	2014-12-27 11:48
process.t	1015 B	-r--r--r--	2014-12-27 11:48
prove.t	47.6 KB	-r--r--r--	2014-12-27 11:49
proveenv.t	338 B	-r--r--r--	2014-12-27 11:49
proverc.t	472 B	-r--r--r--	2014-12-27 11:48
proverun.t	4.14 KB	-r--r--r--	2014-12-27 11:48
proveversion.t	763 B	-r--r--r--	2014-12-27 11:48
regression.t	111.62 KB	-r--r--r--	2014-12-27 11:48
results.t	7.68 KB	-r--r--r--	2014-12-27 11:48
scheduler.t	5.33 KB	-r--r--r--	2014-12-27 11:48
source.t	8.21 KB	-r--r--r--	2014-12-27 11:48
source_handler.t	12.32 KB	-r--r--r--	2014-12-27 11:48
spool.t	3.12 KB	-r--r--r--	2014-12-27 11:48
state.t	7.7 KB	-r--r--r--	2014-12-27 11:48
state_results.t	4.95 KB	-r--r--r--	2014-12-27 11:48
streams.t	6.33 KB	-r--r--r--	2014-12-27 11:48
taint.t	1.3 KB	-r--r--r--	2014-12-27 11:49
testargs.t	4.95 KB	-r--r--r--	2014-12-27 11:48
unicode.t	3.73 KB	-r--r--r--	2014-12-27 11:48
yamlish-output.t	2.44 KB	-r--r--r--	2014-12-27 11:48
yamlish-writer.t	7.17 KB	-r--r--r--	2014-12-27 11:48
yamlish.t	15.01 KB	-r--r--r--	2014-12-27 11:48

Rename

#!/usr/bin/perl -w

use strict;
use warnings;
use lib 't/lib';

use Test::More tests => 76;

use File::Spec;
use TAP::Parser;
use TAP::Parser::Iterator::Array;
use Config;

sub array_ref_from {
    my $string = shift;
    my @lines = split /\n/ => $string;
    return \@lines;
}

# we slurp __DATA__ and then reset it so we don't have to duplicate our TAP
my $offset = tell DATA;
my $tap = do { local $/; <DATA> };
seek DATA, $offset, 0;

my $did_setup    = 0;
my $did_teardown = 0;

my $setup    = sub { $did_setup++ };
my $teardown = sub { $did_teardown++ };

package NoForkProcess;
use base qw( TAP::Parser::Iterator::Process );

sub _use_open3 {return}

package main;

my @schedule = (
    {   name     => 'Process',
        subclass => 'TAP::Parser::Iterator::Process',
        source   => {
            command => [
                $^X,
                File::Spec->catfile(
                    't',
                    'sample-tests',
                    'out_err_mix'
                )
            ],
            merge    => 1,
            setup    => $setup,
            teardown => $teardown,
        },
        after => sub {
            is $did_setup,    1, "setup called";
            is $did_teardown, 1, "teardown called";
        },
        need_open3 => 15,
    },
    {   name     => 'Array',
        subclass => 'TAP::Parser::Iterator::Array',
        source   => array_ref_from($tap),
    },
    {   name     => 'Stream',
        subclass => 'TAP::Parser::Iterator::Stream',
        source   => \*DATA,
    },
    {   name     => 'Process (Perl -e)',
        subclass => 'TAP::Parser::Iterator::Process',
        source =>
          { command => [ $^X, '-e', 'print qq/one\ntwo\n\nthree\n/' ] },
    },
    {   name     => 'Process (NoFork)',
        subclass => 'TAP::Parser::Iterator::Process',
        class    => 'NoForkProcess',
        source =>
          { command => [ $^X, '-e', 'print qq/one\ntwo\n\nthree\n/' ] },
    },
);

sub _can_open3 {
    return $Config{d_fork};
}

for my $test (@schedule) {
    SKIP: {
        my $name       = $test->{name};
        my $need_open3 = $test->{need_open3};
        skip "No open3", $need_open3 if $need_open3 && !_can_open3();
        my $subclass = $test->{subclass};
        my $source   = $test->{source};
        my $class    = $test->{class};
        my $iterator
          = $class
          ? $class->new($source)
          : make_iterator($source);

ok $iterator,     "$name: We should be able to create a new iterator";
        isa_ok $iterator, 'TAP::Parser::Iterator',
          '... and the object it returns';
        isa_ok $iterator, $subclass, '... and the object it returns';

can_ok $iterator, 'exit';
        ok !defined $iterator->exit,
          "$name: ... and it should be undef before we are done ($subclass)";

can_ok $iterator, 'next';
        is $iterator->next, 'one',
          "$name: next() should return the first result";

is $iterator->next, 'two',
          "$name: next() should return the second result";

is $iterator->next, '',
          "$name: next() should return the third result";

is $iterator->next, 'three',
          "$name: next() should return the fourth result";

ok !defined $iterator->next,
          "$name: next() should return undef after it is empty";

is $iterator->exit, 0,
          "$name: ... and exit should now return 0 ($subclass)";

is $iterator->wait, 0,
          "$name: wait should also now return 0 ($subclass)";

if ( my $after = $test->{after} ) {
            $after->();
        }
    }
}

{

# coverage tests for the ctor

my $iterator = make_iterator( IO::Handle->new );

isa_ok $iterator, 'TAP::Parser::Iterator::Stream';

my @die;

eval {
        local $SIG{__DIE__} = sub { push @die, @_ };
        make_iterator( \1 );    # a ref to a scalar
    };

is @die, 1, 'coverage of error case';

like pop @die, qr/Can't iterate with a SCALAR/,
      '...and we died as expected';
}

{

# coverage test for VMS case

my $iterator = make_iterator(
        [   'not ',
            'ok 1 - I hate VMS',
        ]
    );

is $iterator->next, 'not ok 1 - I hate VMS',
      'coverage of VMS line-splitting case';

# coverage test for VMS case - nothing after 'not'

$iterator = make_iterator(
        [   'not ',
        ]
    );

is $iterator->next, 'not ', '...and we find "not" by itself';
}

SKIP: {
    skip "No open3", 4 unless _can_open3();

# coverage testing for TAP::Parser::Iterator::Process ctor

my @die;

eval {
        local $SIG{__DIE__} = sub { push @die, @_ };
        make_iterator( {} );
    };

is @die, 1, 'coverage testing for TPI::Process';

like pop @die, qr/Must supply a command to execute/,
      '...and we died as expected';

my $parser = make_iterator(
        {   command => [
                $^X,
                File::Spec->catfile( 't', 'sample-tests', 'out_err_mix' )
            ],
            merge => 1,
        }
    );

is $parser->{err}, '',    'confirm we set err to empty string';
    is $parser->{sel}, undef, '...and selector to undef';

# And then we read from the parser to sidestep the Mac OS / open3
    # bug which frequently throws an error here otherwise.
    $parser->next;
}

sub make_iterator {
    my $thing = shift;
    my $ref   = ref $thing;
    if ( $ref eq 'GLOB' || UNIVERSAL::isa( $ref, 'IO::Handle' ) ) {
        return TAP::Parser::Iterator::Stream->new($thing);
    }
    elsif ( $ref eq 'ARRAY' ) {
        return TAP::Parser::Iterator::Array->new($thing);
    }
    elsif ( $ref eq 'HASH' ) {
        return TAP::Parser::Iterator::Process->new($thing);
    }
    else {
        die "Can't iterate with a $ref";
    }
}

__DATA__
one
two

three