4 if( $ENV{PERL_CORE} ) {
6 @INC = ('../lib', 'lib');
15 use Test::More tests => 170;
17 use_ok('Test::Harness::Straps');
19 my $strap = Test::Harness::Straps->new;
20 isa_ok( $strap, 'Test::Harness::Straps', 'new()' );
22 ### Testing _is_comment()
25 ok( !$strap->_is_comment("foo", \$comment), '_is_comment(), not a comment' );
26 ok( !defined $comment, ' no comment set' );
28 ok( !$strap->_is_comment("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_comment($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;
63 ok( !$strap->_is_header($unheader),
64 "_is_header(), not a header '$unheader'" );
66 ok( (!grep { exists $strap->{$_} } qw(max todo skip_all)),
67 " max, todo and skip_all are not set" );
71 my @attribs = qw(max skip_all todo);
73 '1..2' => { max => 2 },
74 '1..1' => { max => 1 },
78 '1..0 # Skipped: no leverage found' => { max => 0,
79 skip_all => 'no leverage found',
81 '1..4 # Skipped: no leverage found' => { max => 4,
82 skip_all => 'no leverage found',
84 '1..0 # skip skip skip because' => { max => 0,
85 skip_all => 'skip skip because',
87 '1..10 todo 2 4 10' => { max => 10,
93 '1..10 todo' => { max => 10 },
94 '1..192 todo 4 2 13 192 # Skip skip skip because' =>
101 skip_all => 'skip skip because'
105 for my $header ( sort keys %headers ) {
106 my $expect = $headers{$header};
107 my $strap = Test::Harness::Straps->new;
108 isa_ok( $strap, 'Test::Harness::Straps' );
110 ok( $strap->_is_header($header), "_is_header() is a header '$header'" );
112 is( $strap->{skip_all}, $expect->{skip_all}, ' skip_all set right' )
113 if defined $expect->{skip_all};
115 ok( eq_set( [map $strap->{$_}, grep defined $strap->{$_}, @attribs],
116 [map $expect->{$_}, grep defined $expect->{$_}, @attribs] ),
117 ' the right attributes are there' );
122 ### Testing _is_test()
125 'ok' => { 'ok' => 1 },
126 'not ok' => { 'ok' => 0 },
128 'ok 1' => { 'ok' => 1, number => 1 },
129 'not ok 1' => { 'ok' => 0, number => 1 },
131 'ok 2938' => { 'ok' => 1, number => 2938 },
133 'ok 1066 - and all that' => { 'ok' => 1,
135 name => "- and all that" },
136 'not ok 42 - universal constant' =>
139 name => '- universal constant',
141 'not ok 23 # TODO world peace' => { 'ok' => 0,
144 reason => 'world peace'
146 'ok 11 - have life # TODO get a life' =>
149 name => '- have life',
151 reason => 'get a life'
153 'not ok # TODO' => { 'ok' => 0,
157 'ok # skip' => { 'ok' => 1,
160 'not ok 11 - this is \# all the name # skip this is not'
163 name => '- this is \# all the name',
165 reason => 'this is not'
167 "ok 42 - _is_header() is a header '1..192 todo 4 2 13 192 \\# Skip skip skip because"
170 name => "- _is_header() is a header '1..192 todo 4 2 13 192 \\# Skip skip skip because",
174 for my $line ( sort keys %tests ) {
175 my $expect = $tests{$line};
177 ok( $strap->_is_test($line, \%test), "_is_test() spots '$line'" );
179 foreach my $type (qw(ok number name type reason)) {
180 cmp_ok( $test{$type}, 'eq', $expect->{$type}, " $type" );
189 foreach my $line (@untests) {
190 my $strap = Test::Harness::Straps->new;
191 isa_ok( $strap, 'Test::Harness::Straps' );
194 ok( !$strap->_is_test($line, \%test), "_is_test() disregards '$line'" );
196 # is( keys %test, 0 ) won't work in 5.004 because it's undef.
197 ok( !keys %test, ' and produces no test info' );
201 ### Test _is_bail_out()
204 'Bail out!' => undef,
205 'Bail out! Wing on fire.' => 'Wing on fire.',
206 'BAIL OUT!' => undef,
207 'bail out! - Out of coffee' => '- Out of coffee',
210 for my $line ( sort keys %bails ) {
211 my $expect = $bails{$line};
212 my $strap = Test::Harness::Straps->new;
213 isa_ok( $strap, 'Test::Harness::Straps' );
216 ok( $strap->_is_bail_out($line, \$reason), "_is_bail_out() spots '$line'");
217 is( $reason, $expect, ' with the right reason' );
227 foreach my $line (@unbails) {
228 my $strap = Test::Harness::Straps->new;
229 isa_ok( $strap, 'Test::Harness::Straps' );
233 ok( !$strap->_is_bail_out($line, \$reason),
234 "_is_bail_out() ignores '$line'" );
235 is( $reason, undef, ' and gives no reason' );