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

BEGIN {
    unshift @INC, 't/lib';
}

use strict;
use warnings;

use Test::More;

use TAP::Harness;

my $HARNESS = 'TAP::Harness';

my $source_tests = 't/source_tests';
my $sample_tests = 't/sample-tests';

plan tests => 56;

# note that this test will always pass when run through 'prove'
ok $ENV{HARNESS_ACTIVE},  'HARNESS_ACTIVE env variable should be set';
ok $ENV{HARNESS_VERSION}, 'HARNESS_VERSION env variable should be set';

{
    my @output;
    no warnings 'redefine';
    require TAP::Formatter::Base;
    local *TAP::Formatter::Base::_output = sub {
        my $self = shift;
        push @output => grep { $_ ne '' }
          map {
            local $_ = $_;
            chomp;
            trim($_)
          } map { split /\n/ } @_;
    };

# Make sure verbosity 1 overrides failures and comments.
    my $harness = TAP::Harness->new(
        {   verbosity => 1,
            failures  => 1,
            comments  => 1,
        }
    );
    my $harness_whisper    = TAP::Harness->new( { verbosity  => -1 } );
    my $harness_mute       = TAP::Harness->new( { verbosity  => -2 } );
    my $harness_directives = TAP::Harness->new( { directives => 1 } );
    my $harness_failures   = TAP::Harness->new( { failures   => 1 } );
    my $harness_comments   = TAP::Harness->new( { comments   => 1 } );
    my $harness_fandc      = TAP::Harness->new(
        {   failures => 1,
            comments => 1
        }
    );

can_ok $harness, 'runtests';

# normal tests in verbose mode

ok my $aggregate = _runtests( $harness, "$source_tests/harness" ),
      '... runtests returns the aggregate';

isa_ok $aggregate, 'TAP::Parser::Aggregator';

chomp(@output);

my @expected = (
        "$source_tests/harness ..",
        '1..1',
        'ok 1 - this is a test',
        'ok',
        'All tests successful.',
    );
    my $status           = pop @output;
    my $expected_status  = qr{^Result: PASS$};
    my $summary          = pop @output;
    my $expected_summary = qr{^Files=1, Tests=1, +\d+ wallclock secs};

is_deeply \@output, \@expected, '... the output should be correct';
    like $status, $expected_status,
      '... and the status line should be correct';
    like $summary, $expected_summary,
      '... and the report summary should look correct';

# use an alias for test name

@output = ();
    ok $aggregate
      = _runtests( $harness, [ "$source_tests/harness", 'My Nice Test' ] ),
      'runtests returns the aggregate';

isa_ok $aggregate, 'TAP::Parser::Aggregator';

chomp(@output);

@expected = (
        'My Nice Test ..',
        '1..1',
        'ok 1 - this is a test',
        'ok',
        'All tests successful.',
    );
    $status           = pop @output;
    $expected_status  = qr{^Result: PASS$};
    $summary          = pop @output;
    $expected_summary = qr{^Files=1, Tests=1, +\d+ wallclock secs};

# run same test twice

@output = ();
    ok $aggregate = _runtests(
        $harness, [ "$source_tests/harness", 'My Nice Test' ],
        [ "$source_tests/harness", 'My Nice Test Again' ]
      ),
      'runtests labels returns the aggregate';

isa_ok $aggregate, 'TAP::Parser::Aggregator';

chomp(@output);

@expected = (
        'My Nice Test ........',
        '1..1',
        'ok 1 - this is a test',
        'ok',
        'My Nice Test Again ..',
        '1..1',
        'ok 1 - this is a test',
        'ok',
        'All tests successful.',
    );
    $status           = pop @output;
    $expected_status  = qr{^Result: PASS$};
    $summary          = pop @output;
    $expected_summary = qr{^Files=2, Tests=2, +\d+ wallclock secs};

# normal tests in quiet mode

@output = ();
    ok _runtests( $harness_whisper, "$source_tests/harness" ),
      'Run tests with whisper';

chomp(@output);
    @expected = (
        "$source_tests/harness .. ok",
        'All tests successful.',
    );

$status           = pop @output;
    $expected_status  = qr{^Result: PASS$};
    $summary          = pop @output;
    $expected_summary = qr/^Files=1, Tests=1, +\d+ wallclock secs/;

# normal tests in really_quiet mode

@output = ();
    ok _runtests( $harness_mute, "$source_tests/harness" ), 'Run tests mute';

chomp(@output);
    @expected = (
        'All tests successful.',
    );

$status           = pop @output;
    $expected_status  = qr{^Result: PASS$};
    $summary          = pop @output;
    $expected_summary = qr/^Files=1, Tests=1, +\d+ wallclock secs/;

# normal tests with failures

@output = ();
    ok _runtests( $harness, "$source_tests/harness_failure" ),
      'Run tests with failures';

$status  = pop @output;
    $summary = pop @output;

like $status, qr{^Result: FAIL$}, '... the status line should be correct';

my @summary = @output[ 9 .. $#output ];
    @output = @output[ 0 .. 8 ];

@expected = (
        "$source_tests/harness_failure ..",
        '1..2',
        'ok 1 - this is a test',
        'not ok 2 - this is another test',
        q{#   Failed test 'this is another test'},
        '#   in harness_failure.t at line 5.',
        q{#          got: 'waffle'},
        q{#     expected: 'yarblokos'},
        'Failed 1/2 subtests',
    );

is_deeply \@output, \@expected,
      '... and failing test output should be correct';

my @expected_summary = (
        'Test Summary Report',
        '-------------------',
        "$source_tests/harness_failure (Wstat: 0 Tests: 2 Failed: 1)",
        'Failed test:',
        '2',
    );

is_deeply \@summary, \@expected_summary,
      '... and the failure summary should also be correct';

# quiet tests with failures

@output = ();
    ok _runtests( $harness_whisper, "$source_tests/harness_failure" ),
      'Run whisper tests with failures';

$status   = pop @output;
    $summary  = pop @output;
    @expected = (
        "$source_tests/harness_failure ..",
        'Failed 1/2 subtests',
        'Test Summary Report',
        '-------------------',
        "$source_tests/harness_failure (Wstat: 0 Tests: 2 Failed: 1)",
        'Failed test:',
        '2',
    );

like $status, qr{^Result: FAIL$}, '... the status line should be correct';

is_deeply \@output, \@expected,
      '... and failing test output should be correct';

# really quiet tests with failures

@output = ();
    ok _runtests( $harness_mute, "$source_tests/harness_failure" ),
      'Run mute tests with failures';

$status   = pop @output;
    $summary  = pop @output;
    @expected = (
        'Test Summary Report',
        '-------------------',
        "$source_tests/harness_failure (Wstat: 0 Tests: 2 Failed: 1)",
        'Failed test:',
        '2',
    );

like $status, qr{^Result: FAIL$}, '... the status line should be correct';

is_deeply \@output, \@expected,
      '... and failing test output should be correct';

# only show directives

@output = ();
    ok _runtests(
        $harness_directives,
        "$source_tests/harness_directives"
      ),
      'Run tests with directives';

chomp(@output);

@expected = (
        "$source_tests/harness_directives ..",
        'not ok 2 - we have a something # TODO some output',
        "ok 3 houston, we don't have liftoff # SKIP no funding",
        'ok',
        'All tests successful.',

# ~TODO {{{ this should be an option
        #'Test Summary Report',
        #'-------------------',
        #"$source_tests/harness_directives (Wstat: 0 Tests: 3 Failed: 0)",
        #'Tests skipped:',
        #'3',
        # }}}
    );

$status           = pop @output;
    $summary          = pop @output;
    $expected_summary = qr/^Files=1, Tests=3, +\d+ wallclock secs/;

is_deeply \@output, \@expected, '... the output should be correct';
    like $summary, $expected_summary,
      '... and the report summary should look correct';

like $status, qr{^Result: PASS$},
      '... and the status line should be correct';

# normal tests with bad tap

@output = ();
    ok _runtests( $harness, "$source_tests/harness_badtap" ),
      'Run tests with bad TAP';
    chomp(@output);

@output   = map { trim($_) } @output;
    $status   = pop @output;
    @summary  = @output[ 6 .. ( $#output - 1 ) ];
    @output   = @output[ 0 .. 5 ];
    @expected = (
        "$source_tests/harness_badtap ..",
        '1..2',
        'ok 1 - this is a test',
        'not ok 2 - this is another test',
        '1..2',
        'Failed 1/2 subtests',
    );
    is_deeply \@output, \@expected,
      '... failing test output should be correct';
    like $status, qr{^Result: FAIL$},
      '... and the status line should be correct';
    @expected_summary = (
        'Test Summary Report',
        '-------------------',
        "$source_tests/harness_badtap (Wstat: 0 Tests: 2 Failed: 1)",
        'Failed test:',
        '2',
        'Parse errors: More than one plan found in TAP output',
    );
    is_deeply \@summary, \@expected_summary,
      '... and the badtap summary should also be correct';

# coverage testing for _should_show_failures
    # only show failures

@output = ();
    ok _runtests( $harness_failures, "$source_tests/harness_failure" ),
      'Run tests with failures only';

chomp(@output);

@expected = (
        "$source_tests/harness_failure ..",
        'not ok 2 - this is another test',
        'Failed 1/2 subtests',
        'Test Summary Report',
        '-------------------',
        "$source_tests/harness_failure (Wstat: 0 Tests: 2 Failed: 1)",
        'Failed test:',
        '2',
    );

$status  = pop @output;
    $summary = pop @output;

like $status, qr{^Result: FAIL$}, '... the status line should be correct';
    $expected_summary = qr/^Files=1, Tests=2, +\d+ wallclock secs/;
    is_deeply \@output, \@expected, '... and the output should be correct';

# check the status output for no tests

@output = ();
    ok _runtests( $harness_failures, "$sample_tests/no_output" ),
      'Run tests with failures';

chomp(@output);

@expected = (
        "$sample_tests/no_output ..",
        'No subtests run',
        'Test Summary Report',
        '-------------------',
        "$sample_tests/no_output (Wstat: 0 Tests: 0 Failed: 0)",
        'Parse errors: No plan found in TAP output',
    );

$status  = pop @output;
    $summary = pop @output;

# coverage testing for _should_show_comments
    # only show comments

@output = ();
    ok _runtests( $harness_comments, "$source_tests/harness_failure" ),
      'Run tests with comments';
    chomp(@output);

@expected = (
        "$source_tests/harness_failure ..",
        q{#   Failed test 'this is another test'},
        '#   in harness_failure.t at line 5.',
        q{#          got: 'waffle'},
        q{#     expected: 'yarblokos'},
        'Failed 1/2 subtests',
        'Test Summary Report',
        '-------------------',
        "$source_tests/harness_failure (Wstat: 0 Tests: 2 Failed: 1)",
        'Failed test:',
        '2',
    );

$status  = pop @output;
    $summary = pop @output;

# coverage testing for _should_show_comments and _should_show_failures
    # only show comments and failures

@output = ();
    $ENV{FOO} = 1;
    ok _runtests( $harness_fandc, "$source_tests/harness_failure" ),
      'Run tests with failures and comments';
    delete $ENV{FOO};
    chomp(@output);

@expected = (
        "$source_tests/harness_failure ..",
        'not ok 2 - this is another test',
        q{#   Failed test 'this is another test'},
        '#   in harness_failure.t at line 5.',
        q{#          got: 'waffle'},
        q{#     expected: 'yarblokos'},
        'Failed 1/2 subtests',
        'Test Summary Report',
        '-------------------',
        "$source_tests/harness_failure (Wstat: 0 Tests: 2 Failed: 1)",
        'Failed test:',
        '2',
    );

$status  = pop @output;
    $summary = pop @output;

#XXXX
}

sub trim {
    $_[0] =~ s/^\s+|\s+$//g;
    return $_[0];
}

sub _runtests {
    my ( $harness, @tests ) = @_;
    local $ENV{PERL_TEST_HARNESS_DUMP_TAP} = 0;
    my $aggregate = $harness->runtests(@tests);
    return $aggregate;
}