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