[p5sagit/p5-mst-13.2.git] / lib / Test / Harness / t / strap.t

#!/usr/bin/perl -Tw

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't';
        @INC = ('../lib', 'lib');
    }
    else {
        unshift @INC, 't/lib';
    }
}

use strict;

use Test::More tests => 176;

BEGIN { use_ok('Test::Harness::Straps'); }

my $strap = Test::Harness::Straps->new;
isa_ok( $strap, 'Test::Harness::Straps', 'new()' );

### Testing _is_comment()

my $comment;
ok( !$strap->_is_comment("foo", \$comment), '_is_comment(), not a comment'  );
ok( !defined $comment,                      '  no comment set'              );

ok( !$strap->_is_comment("f # oo", \$comment), '  not a comment with #'     );
ok( !defined $comment,                         '  no comment set'           );

my %comments = (
                "# stuff and things # and stuff"    => 
                                        ' stuff and things # and stuff',
                "    # more things "                => ' more things ',
                "#"                                 => '',
               );

for my $line ( sort keys %comments ) {
    my $line_comment = $comments{$line};
    my $strap = Test::Harness::Straps->new;
    isa_ok( $strap, 'Test::Harness::Straps' );

    my $name = substr($line, 0, 20);
    ok( $strap->_is_comment($line, \$comment),        "  comment '$name'"   );
    is( $comment, $line_comment,                      '  right comment set' );
}


### Testing _is_header()

my @not_headers = (' 1..2',
                   '1..M',
                   '1..-1',
                   '2..2',
                   '1..a',
                   '',
                  );

foreach my $unheader (@not_headers) {
    my $strap = Test::Harness::Straps->new;
    isa_ok( $strap, 'Test::Harness::Straps' );

    ok( !$strap->_is_header($unheader),     
        "_is_header(), not a header '$unheader'" );

    ok( (!grep { exists $strap->{$_} } qw(max todo skip_all)),
        "  max, todo and skip_all are not set" );
}


my @attribs = qw(max skip_all todo);
my %headers = (
   '1..2'                               => { max => 2 },
   '1..1'                               => { max => 1 },
   '1..0'                               => { max => 0,
                                             skip_all => '',
                                           },
   '1..0 # Skipped: no leverage found'  => { max      => 0,
                                             skip_all => 'no leverage found',
                                           },
   '1..4 # Skipped: no leverage found'  => { max      => 4,
                                             skip_all => 'no leverage found',
                                           },
   '1..0 # skip skip skip because'      => { max      => 0,
                                             skip_all => 'skip skip because',
                                           },
   '1..10 todo 2 4 10'                  => { max        => 10,
                                             'todo'       => { 2  => 1,
                                                               4  => 1,
                                                               10 => 1,
                                                           },
                                           },
   '1..10 todo'                         => { max        => 10 },
   '1..192 todo 4 2 13 192 # Skip skip skip because'   => 
                                           { max     => 192,
                                             'todo'    => { 4   => 1, 
                                                            2   => 1, 
                                                            13  => 1, 
                                                            192 => 1,
                                                        },
                                             skip_all => 'skip skip because'
                                           }
);

for my $header ( sort keys %headers ) {
    my $expect = $headers{$header};
    my $strap = Test::Harness::Straps->new;
    isa_ok( $strap, 'Test::Harness::Straps' );

    ok( $strap->_is_header($header),    "_is_header() is a header '$header'" );

    is( $strap->{skip_all}, $expect->{skip_all},      '  skip_all set right' )
      if defined $expect->{skip_all};

    ok( eq_set( [map $strap->{$_},  grep defined $strap->{$_},  @attribs],
                [map $expect->{$_}, grep defined $expect->{$_}, @attribs] ),
        '  the right attributes are there' );
}


### Testing _is_test()

my %tests = (
             'ok'       => { 'ok' => 1 },
             'not ok'   => { 'ok' => 0 },

             'ok 1'     => { 'ok' => 1, number => 1 },
             'not ok 1' => { 'ok' => 0, number => 1 },

             'ok 2938'  => { 'ok' => 1, number => 2938 },

             'ok 1066 - and all that'   => { 'ok'     => 1,
                                             number => 1066,
                                             name   => "- and all that" },
             'not ok 42 - universal constant'   => 
                                      { 'ok'     => 0,
                                        number => 42,
                                        name   => '- universal constant',
                                      },
             'not ok 23 # TODO world peace'     => { 'ok'     => 0,
                                                     number => 23,
                                                     type   => 'todo',
                                                     reason => 'world peace'
                                                   },
             'ok 11 - have life # TODO get a life'  => 
                                      { 'ok'     => 1,
                                        number => 11,
                                        name   => '- have life',
                                        type   => 'todo',
                                        reason => 'get a life'
                                      },
             'not ok # TODO'    => { 'ok'     => 0,
                                     type   => 'todo',
                                     reason => ''
                                   },
             'ok # skip'        => { 'ok'     => 1,
                                     type   => 'skip',
                                   },
             'not ok 11 - this is \# all the name # skip this is not'
                                => { 'ok'     => 0,
                                     number => 11,
                                     name   => '- this is \# all the name',
                                     type   => 'skip',
                                     reason => 'this is not'
                                   },
             "ok 42 - _is_header() is a header '1..192 todo 4 2 13 192 \\# Skip skip skip because"
                                => { 'ok'   => 1,
                                     number => 42,
                                     name   => "- _is_header() is a header '1..192 todo 4 2 13 192 \\# Skip skip skip because",
                                   },
            );

for my $line ( sort keys %tests ) {
    my $expect = $tests{$line};
    my %test;
    ok( $strap->_is_test($line, \%test),    "_is_test() spots '$line'" );

    foreach my $type (qw(ok number name type reason)) {
        cmp_ok( $test{$type}, 'eq', $expect->{$type}, "  $type" );
    }
}

my @untests = (
               ' ok',
               'not',
               'okay 23',
              );
foreach my $line (@untests) {
    my $strap = Test::Harness::Straps->new;
    isa_ok( $strap, 'Test::Harness::Straps' );

    my %test = ();
    ok( !$strap->_is_test($line, \%test),    "_is_test() disregards '$line'" );

    # is( keys %test, 0 ) won't work in 5.004 because it's undef.
    ok( !keys %test,                         '  and produces no test info'   );
}


### Test _is_bail_out()

my %bails = (
             'Bail out!'                 =>  undef,
             'Bail out!  Wing on fire.'  => 'Wing on fire.',
             'BAIL OUT!'                 => undef,
             'bail out! - Out of coffee' => '- Out of coffee',
            );

for my $line ( sort keys %bails ) {
    my $expect = $bails{$line};
    my $strap = Test::Harness::Straps->new;
    isa_ok( $strap, 'Test::Harness::Straps' );

    my $reason;
    ok( $strap->_is_bail_out($line, \$reason), "_is_bail_out() spots '$line'");
    is( $reason, $expect,                       '  with the right reason' );
}

my @unbails = (
               '  Bail out!',
               'BAIL OUT',
               'frobnitz',
               'ok 23 - BAIL OUT!',
              );

foreach my $line (@unbails) {
    my $strap = Test::Harness::Straps->new;
    isa_ok( $strap, 'Test::Harness::Straps' );

    my $reason;

    ok( !$strap->_is_bail_out($line, \$reason),  
                                       "_is_bail_out() ignores '$line'" );
    is( $reason, undef,                         '  and gives no reason' );
}
Commit	Line	Data
3c87ea76	1	#!/usr/bin/perl -Tw
13287dd5	2
	3	BEGIN {
	4	if( $ENV{PERL_CORE} ) {
	5	chdir 't';
	6	@INC = ('../lib', 'lib');
	7	}
	8	else {
	9	unshift @INC, 't/lib';
	10	}
	11	}
	12
	13	use strict;
	14
3c87ea76	15	use Test::More tests => 176;
13287dd5	16
60e33a80	17	BEGIN { use_ok('Test::Harness::Straps'); }
13287dd5	18
13287dd5	19	my $strap = Test::Harness::Straps->new;
27caa5c1	20	isa_ok( $strap, 'Test::Harness::Straps', 'new()' );
13287dd5	21
	22	### Testing _is_comment()
	23
	24	my $comment;
	25	ok( !$strap->_is_comment("foo", \$comment), '_is_comment(), not a comment' );
	26	ok( !defined $comment, ' no comment set' );
	27
	28	ok( !$strap->_is_comment("f # oo", \$comment), ' not a comment with #' );
	29	ok( !defined $comment, ' no comment set' );
	30
	31	my %comments = (
	32	"# stuff and things # and stuff" =>
	33	' stuff and things # and stuff',
	34	" # more things " => ' more things ',
	35	"#" => '',
	36	);
	37
e4fc8a1e	38	for my $line ( sort keys %comments ) {
e4fc8a1e	39	my $line_comment = $comments{$line};
13287dd5	40	my $strap = Test::Harness::Straps->new;
27caa5c1	41	isa_ok( $strap, 'Test::Harness::Straps' );
13287dd5	42
	43	my $name = substr($line, 0, 20);
	44	ok( $strap->_is_comment($line, \$comment), " comment '$name'" );
	45	is( $comment, $line_comment, ' right comment set' );
	46	}
	47
	48
	49
	50	### Testing _is_header()
	51
	52	my @not_headers = (' 1..2',
	53	'1..M',
	54	'1..-1',
	55	'2..2',
	56	'1..a',
	57	'',
	58	);
	59
	60	foreach my $unheader (@not_headers) {
	61	my $strap = Test::Harness::Straps->new;
3c87ea76	62	isa_ok( $strap, 'Test::Harness::Straps' );
13287dd5	63
	64	ok( !$strap->_is_header($unheader),
	65	"_is_header(), not a header '$unheader'" );
	66
	67	ok( (!grep { exists $strap->{$_} } qw(max todo skip_all)),
	68	" max, todo and skip_all are not set" );
	69	}
	70
	71
	72	my @attribs = qw(max skip_all todo);
	73	my %headers = (
	74	'1..2' => { max => 2 },
	75	'1..1' => { max => 1 },
a72fde19	76	'1..0' => { max => 0,
	77	skip_all => '',
	78	},
13287dd5	79	'1..0 # Skipped: no leverage found' => { max => 0,
	80	skip_all => 'no leverage found',
	81	},
	82	'1..4 # Skipped: no leverage found' => { max => 4,
	83	skip_all => 'no leverage found',
	84	},
	85	'1..0 # skip skip skip because' => { max => 0,
	86	skip_all => 'skip skip because',
	87	},
	88	'1..10 todo 2 4 10' => { max => 10,
	89	'todo' => { 2 => 1,
a72fde19	90	4 => 1,
a72fde19	91	10 => 1,
13287dd5	92	},
	93	},
	94	'1..10 todo' => { max => 10 },
	95	'1..192 todo 4 2 13 192 # Skip skip skip because' =>
	96	{ max => 192,
	97	'todo' => { 4 => 1,
a72fde19	98	2 => 1,
	99	13 => 1,
	100	192 => 1,
13287dd5	101	},
	102	skip_all => 'skip skip because'
	103	}
	104	);
	105
e4fc8a1e	106	for my $header ( sort keys %headers ) {
e4fc8a1e	107	my $expect = $headers{$header};
13287dd5	108	my $strap = Test::Harness::Straps->new;
27caa5c1	109	isa_ok( $strap, 'Test::Harness::Straps' );
13287dd5	110
	111	ok( $strap->_is_header($header), "_is_header() is a header '$header'" );
	112
	113	is( $strap->{skip_all}, $expect->{skip_all}, ' skip_all set right' )
	114	if defined $expect->{skip_all};
	115
	116	ok( eq_set( [map $strap->{$_}, grep defined $strap->{$_}, @attribs],
	117	[map $expect->{$_}, grep defined $expect->{$_}, @attribs] ),
	118	' the right attributes are there' );
	119	}
	120
	121
	122
	123	### Testing _is_test()
	124
	125	my %tests = (
	126	'ok' => { 'ok' => 1 },
	127	'not ok' => { 'ok' => 0 },
	128
	129	'ok 1' => { 'ok' => 1, number => 1 },
	130	'not ok 1' => { 'ok' => 0, number => 1 },
	131
	132	'ok 2938' => { 'ok' => 1, number => 2938 },
	133
	134	'ok 1066 - and all that' => { 'ok' => 1,
	135	number => 1066,
	136	name => "- and all that" },
	137	'not ok 42 - universal constant' =>
	138	{ 'ok' => 0,
	139	number => 42,
	140	name => '- universal constant',
	141	},
	142	'not ok 23 # TODO world peace' => { 'ok' => 0,
	143	number => 23,
	144	type => 'todo',
	145	reason => 'world peace'
	146	},
	147	'ok 11 - have life # TODO get a life' =>
	148	{ 'ok' => 1,
	149	number => 11,
	150	name => '- have life',
	151	type => 'todo',
	152	reason => 'get a life'
	153	},
	154	'not ok # TODO' => { 'ok' => 0,
	155	type => 'todo',
	156	reason => ''
	157	},
	158	'ok # skip' => { 'ok' => 1,
	159	type => 'skip',
	160	},
	161	'not ok 11 - this is \# all the name # skip this is not'
	162	=> { 'ok' => 0,
	163	number => 11,
	164	name => '- this is \# all the name',
	165	type => 'skip',
	166	reason => 'this is not'
	167	},
	168	"ok 42 - _is_header() is a header '1..192 todo 4 2 13 192 \\# Skip skip skip because"
	169	=> { 'ok' => 1,
	170	number => 42,
	171	name => "- _is_header() is a header '1..192 todo 4 2 13 192 \\# Skip skip skip because",
	172	},
	173	);
174
e4fc8a1e	175	for my $line ( sort keys %tests ) {
e4fc8a1e	176	my $expect = $tests{$line};
13287dd5	177	my %test;
	178	ok( $strap->_is_test($line, \%test), "_is_test() spots '$line'" );
	179
	180	foreach my $type (qw(ok number name type reason)) {
	181	cmp_ok( $test{$type}, 'eq', $expect->{$type}, " $type" );
	182	}
	183	}
	184
	185	my @untests = (
	186	' ok',
	187	'not',
	188	'okay 23',
	189	);
	190	foreach my $line (@untests) {
	191	my $strap = Test::Harness::Straps->new;
27caa5c1	192	isa_ok( $strap, 'Test::Harness::Straps' );
27caa5c1	193
13287dd5	194	my %test = ();
	195	ok( !$strap->_is_test($line, \%test), "_is_test() disregards '$line'" );
	196
	197	# is( keys %test, 0 ) won't work in 5.004 because it's undef.
	198	ok( !keys %test, ' and produces no test info' );
	199	}
	200
	201
	202	### Test _is_bail_out()
	203
	204	my %bails = (
	205	'Bail out!' => undef,
	206	'Bail out! Wing on fire.' => 'Wing on fire.',
	207	'BAIL OUT!' => undef,
	208	'bail out! - Out of coffee' => '- Out of coffee',
	209	);
	210
e4fc8a1e	211	for my $line ( sort keys %bails ) {
e4fc8a1e	212	my $expect = $bails{$line};
13287dd5	213	my $strap = Test::Harness::Straps->new;
27caa5c1	214	isa_ok( $strap, 'Test::Harness::Straps' );
27caa5c1	215
13287dd5	216	my $reason;
	217	ok( $strap->_is_bail_out($line, \$reason), "_is_bail_out() spots '$line'");
	218	is( $reason, $expect, ' with the right reason' );
	219	}
	220
	221	my @unbails = (
	222	' Bail out!',
	223	'BAIL OUT',
	224	'frobnitz',
	225	'ok 23 - BAIL OUT!',
	226	);
	227
	228	foreach my $line (@unbails) {
	229	my $strap = Test::Harness::Straps->new;
27caa5c1	230	isa_ok( $strap, 'Test::Harness::Straps' );
27caa5c1	231
13287dd5	232	my $reason;
	233
	234	ok( !$strap->_is_bail_out($line, \$reason),
	235	"_is_bail_out() ignores '$line'" );
	236	is( $reason, undef, ' and gives no reason' );
	237	}