1N/A#!/usr/bin/perl -w
1N/A
1N/ABEGIN {
1N/A if( $ENV{PERL_CORE} ) {
1N/A chdir 't';
1N/A @INC = ('../lib', 'lib');
1N/A }
1N/A else {
1N/A unshift @INC, 't/lib';
1N/A }
1N/A}
1N/A
1N/Ause strict;
1N/A
1N/Ause Test::More tests => 170;
1N/A
1N/ABEGIN { use_ok('Test::Harness::Straps'); }
1N/A
1N/Amy $strap = Test::Harness::Straps->new;
1N/Aisa_ok( $strap, 'Test::Harness::Straps', 'new()' );
1N/A
1N/A### Testing _is_comment()
1N/A
1N/Amy $comment;
1N/Aok( !$strap->_is_comment("foo", \$comment), '_is_comment(), not a comment' );
1N/Aok( !defined $comment, ' no comment set' );
1N/A
1N/Aok( !$strap->_is_comment("f # oo", \$comment), ' not a comment with #' );
1N/Aok( !defined $comment, ' no comment set' );
1N/A
1N/Amy %comments = (
1N/A "# stuff and things # and stuff" =>
1N/A ' stuff and things # and stuff',
1N/A " # more things " => ' more things ',
1N/A "#" => '',
1N/A );
1N/A
1N/Afor my $line ( sort keys %comments ) {
1N/A my $line_comment = $comments{$line};
1N/A my $strap = Test::Harness::Straps->new;
1N/A isa_ok( $strap, 'Test::Harness::Straps' );
1N/A
1N/A my $name = substr($line, 0, 20);
1N/A ok( $strap->_is_comment($line, \$comment), " comment '$name'" );
1N/A is( $comment, $line_comment, ' right comment set' );
1N/A}
1N/A
1N/A
1N/A
1N/A### Testing _is_header()
1N/A
1N/Amy @not_headers = (' 1..2',
1N/A '1..M',
1N/A '1..-1',
1N/A '2..2',
1N/A '1..a',
1N/A '',
1N/A );
1N/A
1N/Aforeach my $unheader (@not_headers) {
1N/A my $strap = Test::Harness::Straps->new;
1N/A
1N/A ok( !$strap->_is_header($unheader),
1N/A "_is_header(), not a header '$unheader'" );
1N/A
1N/A ok( (!grep { exists $strap->{$_} } qw(max todo skip_all)),
1N/A " max, todo and skip_all are not set" );
1N/A}
1N/A
1N/A
1N/Amy @attribs = qw(max skip_all todo);
1N/Amy %headers = (
1N/A '1..2' => { max => 2 },
1N/A '1..1' => { max => 1 },
1N/A '1..0' => { max => 0,
1N/A skip_all => '',
1N/A },
1N/A '1..0 # Skipped: no leverage found' => { max => 0,
1N/A skip_all => 'no leverage found',
1N/A },
1N/A '1..4 # Skipped: no leverage found' => { max => 4,
1N/A skip_all => 'no leverage found',
1N/A },
1N/A '1..0 # skip skip skip because' => { max => 0,
1N/A skip_all => 'skip skip because',
1N/A },
1N/A '1..10 todo 2 4 10' => { max => 10,
1N/A 'todo' => { 2 => 1,
1N/A 4 => 1,
1N/A 10 => 1,
1N/A },
1N/A },
1N/A '1..10 todo' => { max => 10 },
1N/A '1..192 todo 4 2 13 192 # Skip skip skip because' =>
1N/A { max => 192,
1N/A 'todo' => { 4 => 1,
1N/A 2 => 1,
1N/A 13 => 1,
1N/A 192 => 1,
1N/A },
1N/A skip_all => 'skip skip because'
1N/A }
1N/A);
1N/A
1N/Afor my $header ( sort keys %headers ) {
1N/A my $expect = $headers{$header};
1N/A my $strap = Test::Harness::Straps->new;
1N/A isa_ok( $strap, 'Test::Harness::Straps' );
1N/A
1N/A ok( $strap->_is_header($header), "_is_header() is a header '$header'" );
1N/A
1N/A is( $strap->{skip_all}, $expect->{skip_all}, ' skip_all set right' )
1N/A if defined $expect->{skip_all};
1N/A
1N/A ok( eq_set( [map $strap->{$_}, grep defined $strap->{$_}, @attribs],
1N/A [map $expect->{$_}, grep defined $expect->{$_}, @attribs] ),
1N/A ' the right attributes are there' );
1N/A}
1N/A
1N/A
1N/A
1N/A### Testing _is_test()
1N/A
1N/Amy %tests = (
1N/A 'ok' => { 'ok' => 1 },
1N/A 'not ok' => { 'ok' => 0 },
1N/A
1N/A 'ok 1' => { 'ok' => 1, number => 1 },
1N/A 'not ok 1' => { 'ok' => 0, number => 1 },
1N/A
1N/A 'ok 2938' => { 'ok' => 1, number => 2938 },
1N/A
1N/A 'ok 1066 - and all that' => { 'ok' => 1,
1N/A number => 1066,
1N/A name => "- and all that" },
1N/A 'not ok 42 - universal constant' =>
1N/A { 'ok' => 0,
1N/A number => 42,
1N/A name => '- universal constant',
1N/A },
1N/A 'not ok 23 # TODO world peace' => { 'ok' => 0,
1N/A number => 23,
1N/A type => 'todo',
1N/A reason => 'world peace'
1N/A },
1N/A 'ok 11 - have life # TODO get a life' =>
1N/A { 'ok' => 1,
1N/A number => 11,
1N/A name => '- have life',
1N/A type => 'todo',
1N/A reason => 'get a life'
1N/A },
1N/A 'not ok # TODO' => { 'ok' => 0,
1N/A type => 'todo',
1N/A reason => ''
1N/A },
1N/A 'ok # skip' => { 'ok' => 1,
1N/A type => 'skip',
1N/A },
1N/A 'not ok 11 - this is \# all the name # skip this is not'
1N/A => { 'ok' => 0,
1N/A number => 11,
1N/A name => '- this is \# all the name',
1N/A type => 'skip',
1N/A reason => 'this is not'
1N/A },
1N/A "ok 42 - _is_header() is a header '1..192 todo 4 2 13 192 \\# Skip skip skip because"
1N/A => { 'ok' => 1,
1N/A number => 42,
1N/A name => "- _is_header() is a header '1..192 todo 4 2 13 192 \\# Skip skip skip because",
1N/A },
1N/A );
1N/A
1N/Afor my $line ( sort keys %tests ) {
1N/A my $expect = $tests{$line};
1N/A my %test;
1N/A ok( $strap->_is_test($line, \%test), "_is_test() spots '$line'" );
1N/A
1N/A foreach my $type (qw(ok number name type reason)) {
1N/A cmp_ok( $test{$type}, 'eq', $expect->{$type}, " $type" );
1N/A }
1N/A}
1N/A
1N/Amy @untests = (
1N/A ' ok',
1N/A 'not',
1N/A 'okay 23',
1N/A );
1N/Aforeach my $line (@untests) {
1N/A my $strap = Test::Harness::Straps->new;
1N/A isa_ok( $strap, 'Test::Harness::Straps' );
1N/A
1N/A my %test = ();
1N/A ok( !$strap->_is_test($line, \%test), "_is_test() disregards '$line'" );
1N/A
1N/A # is( keys %test, 0 ) won't work in 5.004 because it's undef.
1N/A ok( !keys %test, ' and produces no test info' );
1N/A}
1N/A
1N/A
1N/A### Test _is_bail_out()
1N/A
1N/Amy %bails = (
1N/A 'Bail out!' => undef,
1N/A 'Bail out! Wing on fire.' => 'Wing on fire.',
1N/A 'BAIL OUT!' => undef,
1N/A 'bail out! - Out of coffee' => '- Out of coffee',
1N/A );
1N/A
1N/Afor my $line ( sort keys %bails ) {
1N/A my $expect = $bails{$line};
1N/A my $strap = Test::Harness::Straps->new;
1N/A isa_ok( $strap, 'Test::Harness::Straps' );
1N/A
1N/A my $reason;
1N/A ok( $strap->_is_bail_out($line, \$reason), "_is_bail_out() spots '$line'");
1N/A is( $reason, $expect, ' with the right reason' );
1N/A}
1N/A
1N/Amy @unbails = (
1N/A ' Bail out!',
1N/A 'BAIL OUT',
1N/A 'frobnitz',
1N/A 'ok 23 - BAIL OUT!',
1N/A );
1N/A
1N/Aforeach my $line (@unbails) {
1N/A my $strap = Test::Harness::Straps->new;
1N/A isa_ok( $strap, 'Test::Harness::Straps' );
1N/A
1N/A my $reason;
1N/A
1N/A ok( !$strap->_is_bail_out($line, \$reason),
1N/A "_is_bail_out() ignores '$line'" );
1N/A is( $reason, undef, ' and gives no reason' );
1N/A}