6 if( $ENV{PERL_CORE} ) {
8 @INC = ('../lib', 'lib');
11 unshift @INC, 't/lib';
15 use Test::More tests => 89;
17 BEGIN { use_ok('Test::Harness::Straps'); }
19 my $strap = Test::Harness::Straps->new;
20 isa_ok( $strap, 'Test::Harness::Straps', 'new()' );
22 ### Testing _is_diagnostic()
25 ok( !$strap->_is_diagnostic("foo", \$comment), '_is_diagnostic(), not a comment' );
26 ok( !defined $comment, ' no comment set' );
28 ok( !$strap->_is_diagnostic("f # oo", \$comment), ' not a comment with #' );
29 ok( !defined $comment, ' no comment set' );
32 "# stuff and things # and stuff" =>
33 ' stuff and things # and stuff',
34 " # more things " => ' more things ',
38 for my $line ( sort keys %comments ) {
39 my $line_comment = $comments{$line};
40 my $strap = Test::Harness::Straps->new;
41 isa_ok( $strap, 'Test::Harness::Straps' );
43 my $name = substr($line, 0, 20);
44 ok( $strap->_is_diagnostic($line, \$comment), " comment '$name'" );
45 is( $comment, $line_comment, ' right comment set' );
50 ### Testing _is_header()
52 my @not_headers = (' 1..2',
60 foreach my $unheader (@not_headers) {
61 my $strap = Test::Harness::Straps->new;
62 isa_ok( $strap, 'Test::Harness::Straps' );
64 ok( !$strap->_is_header($unheader),
65 "_is_header(), not a header '$unheader'" );
67 ok( (!grep { exists $strap->{$_} } qw(max todo skip_all)),
68 " max, todo and skip_all are not set" );
72 my @attribs = qw(max skip_all todo);
74 '1..2' => { max => 2 },
75 '1..1' => { max => 1 },
79 '1..0 # Skipped: no leverage found' => { max => 0,
80 skip_all => 'no leverage found',
82 '1..4 # Skipped: no leverage found' => { max => 4,
83 skip_all => 'no leverage found',
85 '1..0 # skip skip skip because' => { max => 0,
86 skip_all => 'skip skip because',
88 '1..10 todo 2 4 10' => { max => 10,
94 '1..10 todo' => { max => 10 },
95 '1..192 todo 4 2 13 192 # Skip skip skip because' =>
102 skip_all => 'skip skip because'
106 for my $header ( sort keys %headers ) {
107 my $expect = $headers{$header};
108 my $strap = Test::Harness::Straps->new;
109 isa_ok( $strap, 'Test::Harness::Straps' );
111 ok( $strap->_is_header($header), "_is_header() is a header '$header'" );
113 is( $strap->{skip_all}, $expect->{skip_all}, ' skip_all set right' )
114 if defined $expect->{skip_all};
116 ok( eq_set( [map $strap->{$_}, grep defined $strap->{$_}, @attribs],
117 [map $expect->{$_}, grep defined $expect->{$_}, @attribs] ),
118 ' the right attributes are there' );
123 ### Test _is_bail_out()
126 'Bail out!' => undef,
127 'Bail out! Wing on fire.' => 'Wing on fire.',
128 'BAIL OUT!' => undef,
129 'bail out! - Out of coffee' => '- Out of coffee',
132 for my $line ( sort keys %bails ) {
133 my $expect = $bails{$line};
134 my $strap = Test::Harness::Straps->new;
135 isa_ok( $strap, 'Test::Harness::Straps' );
138 ok( $strap->_is_bail_out($line, \$reason), "_is_bail_out() spots '$line'");
139 is( $reason, $expect, ' with the right reason' );
149 foreach my $line (@unbails) {
150 my $strap = Test::Harness::Straps->new;
151 isa_ok( $strap, 'Test::Harness::Straps' );
155 ok( !$strap->_is_bail_out($line, \$reason),
156 "_is_bail_out() ignores '$line'" );
157 is( $reason, undef, ' and gives no reason' );