1#!/usr/bin/perl -w 2 3BEGIN { 4 unshift @INC, 't/lib'; 5} 6 7use strict; 8use warnings; 9 10use Test::More tests => 79; 11 12use Config; 13use IO::File; 14use IO::Handle; 15use File::Spec; 16 17use TAP::Parser::Source; 18use TAP::Parser::SourceHandler; 19 20my $IS_WIN32 = ( $^O =~ /^(MS)?Win32$/ ); 21my $HAS_SH = -x '/bin/sh'; 22my $HAS_ECHO = -x '/bin/echo'; 23 24my $dir = File::Spec->catdir( 25 't', 26 'source_tests' 27); 28 29my $perl = $^X; 30 31my %file = map { $_ => File::Spec->catfile( $dir, $_ ) } 32 qw( source source.1 source.bat source.pl source.sh source_args.sh source.t 33 source.tap ); 34 35# Abstract base class tests 36{ 37 my $class = 'TAP::Parser::SourceHandler'; 38 my $source = TAP::Parser::Source->new; 39 my $error; 40 41 can_ok $class, 'can_handle'; 42 eval { $class->can_handle($source) }; 43 $error = $@; 44 like $error, qr/^Abstract method 'can_handle'/, 45 '... with an appropriate error message'; 46 47 can_ok $class, 'make_iterator'; 48 eval { $class->make_iterator($source) }; 49 $error = $@; 50 like $error, qr/^Abstract method 'make_iterator'/, 51 '... with an appropriate error message'; 52} 53 54# Executable source tests 55{ 56 my $class = 'TAP::Parser::SourceHandler::Executable'; 57 my $tests = { 58 default_vote => 0, 59 can_handle => [ 60 { name => '.sh', 61 meta => { 62 is_file => 1, 63 file => { lc_ext => '.sh' } 64 }, 65 vote => 0, 66 }, 67 { name => '.bat', 68 meta => { 69 is_file => 1, 70 file => { lc_ext => '.bat' } 71 }, 72 vote => 0.8, 73 }, 74 { name => 'executable bit', 75 meta => { 76 is_file => 1, 77 file => { lc_ext => '', execute => 1 } 78 }, 79 vote => 0.25, 80 }, 81 { name => 'exec hash', 82 raw => { exec => 'foo' }, 83 meta => { is_hash => 1 }, 84 vote => 0.9, 85 }, 86 ], 87 make_iterator => [ 88 { name => "valid executable", 89 raw => [ 90 $perl, ( $ENV{PERL_CORE} ? '-I../../lib' : () ), 91 (map { "-I$_" } split /$Config{path_sep}/, $ENV{PERL5LIB} || ''), 92 '-It/lib', '-T', $file{source} 93 ], 94 iclass => 'TAP::Parser::Iterator::Process', 95 output => [ '1..1', 'ok 1 - source' ], 96 assemble_meta => 1, 97 }, 98 { name => "invalid source->raw", 99 raw => "$perl -It/lib $file{source}", 100 error => qr/^No command found/, 101 }, 102 { name => "non-existent source->raw", 103 raw => [], 104 error => qr/^No command found/, 105 }, 106 { name => $file{'source.sh'}, 107 raw => \$file{'source.sh'}, 108 skip => $HAS_SH && $HAS_ECHO ? 0 : 1, 109 skip_reason => 'no /bin/sh, /bin/echo', 110 iclass => 'TAP::Parser::Iterator::Process', 111 output => [ '1..1', 'ok 1 - source.sh' ], 112 assemble_meta => 1, 113 }, 114 { name => $file{'source_args.sh'}, 115 raw => { exec => [ $file{'source_args.sh'} ] }, 116 test_args => ['foo'], 117 skip => $HAS_SH && $HAS_ECHO ? 0 : 1, 118 skip_reason => 'no /bin/sh, /bin/echo', 119 iclass => 'TAP::Parser::Iterator::Process', 120 output => [ '1..1', 'ok 1 - source_args.sh foo' ], 121 assemble_meta => 1, 122 }, 123 { name => $file{'source.bat'}, 124 raw => \$file{'source.bat'}, 125 skip => $IS_WIN32 ? 0 : 1, 126 skip_reason => 'not running Win32', 127 iclass => 'TAP::Parser::Iterator::Process', 128 output => [ '1..1', 'ok 1 - source.bat' ], 129 assemble_meta => 1, 130 }, 131 ], 132 }; 133 134 test_handler( $class, $tests ); 135} 136 137# Perl source tests 138{ 139 my $class = 'TAP::Parser::SourceHandler::Perl'; 140 my $tests = { 141 default_vote => 0, 142 can_handle => [ 143 { name => '.t', 144 meta => { 145 is_file => 1, 146 file => { lc_ext => '.t', dir => '' } 147 }, 148 vote => 0.8, 149 }, 150 { name => '.pl', 151 meta => { 152 is_file => 1, 153 file => { lc_ext => '.pl', dir => '' } 154 }, 155 vote => 0.9, 156 }, 157 { name => 't/.../file', 158 meta => { 159 is_file => 1, 160 file => { lc_ext => '', dir => 't' } 161 }, 162 vote => 0.75, 163 }, 164 { name => '#!...perl', 165 meta => { 166 is_file => 1, 167 file => { 168 lc_ext => '', dir => '', shebang => '#!/usr/bin/perl' 169 } 170 }, 171 vote => 0.9, 172 }, 173 { name => 'file default', 174 meta => { 175 is_file => 1, 176 file => { lc_ext => '', dir => '' } 177 }, 178 vote => 0.25, 179 }, 180 ], 181 make_iterator => [ 182 { name => $file{source}, 183 raw => \$file{source}, 184 iclass => 'TAP::Parser::Iterator::Process', 185 output => [ '1..1', 'ok 1 - source' ], 186 assemble_meta => 1, 187 }, 188 ], 189 }; 190 191 test_handler( $class, $tests ); 192 193 # internals tests! 194 { 195 my $source = TAP::Parser::Source->new->raw( \$file{source} ); 196 $source->assemble_meta; 197 my $iterator = $class->make_iterator($source); 198 my @command = @{ $iterator->{command} }; 199 ok( grep( $_ =~ /^['"]?-T['"]?$/, @command ), 200 '... and it should find the taint switch' 201 ); 202 } 203} 204 205# Raw TAP source tests 206{ 207 my $class = 'TAP::Parser::SourceHandler::RawTAP'; 208 my $tests = { 209 default_vote => 0, 210 can_handle => [ 211 { name => 'file', 212 meta => { is_file => 1 }, 213 raw => \'', 214 vote => 0, 215 }, 216 { name => 'scalar w/newlines', 217 raw => \"hello\nworld\n", 218 vote => 0.3, 219 assemble_meta => 1, 220 }, 221 { name => '1..10', 222 raw => \"1..10\n", 223 vote => 0.9, 224 assemble_meta => 1, 225 }, 226 { name => 'array', 227 raw => [ '1..1', 'ok 1' ], 228 vote => 0.5, 229 assemble_meta => 1, 230 }, 231 ], 232 make_iterator => [ 233 { name => 'valid scalar', 234 raw => \"1..1\nok 1 - raw\n", 235 iclass => 'TAP::Parser::Iterator::Array', 236 output => [ '1..1', 'ok 1 - raw' ], 237 assemble_meta => 1, 238 }, 239 { name => 'valid array', 240 raw => [ '1..1', 'ok 1 - raw' ], 241 iclass => 'TAP::Parser::Iterator::Array', 242 output => [ '1..1', 'ok 1 - raw' ], 243 assemble_meta => 1, 244 }, 245 ], 246 }; 247 248 test_handler( $class, $tests ); 249} 250 251# Text file TAP source tests 252{ 253 my $class = 'TAP::Parser::SourceHandler::File'; 254 my $tests = { 255 default_vote => 0, 256 can_handle => [ 257 { name => '.tap', 258 meta => { 259 is_file => 1, 260 file => { lc_ext => '.tap' } 261 }, 262 vote => 0.9, 263 }, 264 { name => '.foo with config', 265 meta => { 266 is_file => 1, 267 file => { lc_ext => '.foo' } 268 }, 269 config => { File => { extensions => ['.foo'] } }, 270 vote => 0.9, 271 }, 272 ], 273 make_iterator => [ 274 { name => $file{'source.tap'}, 275 raw => \$file{'source.tap'}, 276 iclass => 'TAP::Parser::Iterator::Stream', 277 output => [ '1..1', 'ok 1 - source.tap' ], 278 assemble_meta => 1, 279 }, 280 { name => $file{'source.1'}, 281 raw => \$file{'source.1'}, 282 config => { File => { extensions => ['.1'] } }, 283 iclass => 'TAP::Parser::Iterator::Stream', 284 output => [ '1..1', 'ok 1 - source.1' ], 285 assemble_meta => 1, 286 }, 287 ], 288 }; 289 290 test_handler( $class, $tests ); 291} 292 293# IO::Handle TAP source tests 294{ 295 my $class = 'TAP::Parser::SourceHandler::Handle'; 296 my $tests = { 297 default_vote => 0, 298 can_handle => [ 299 { name => 'glob', 300 meta => { is_glob => 1 }, 301 vote => 0.8, 302 }, 303 { name => 'IO::Handle', 304 raw => IO::Handle->new, 305 vote => 0.9, 306 assemble_meta => 1, 307 }, 308 ], 309 make_iterator => [ 310 { name => 'IO::Handle', 311 raw => IO::File->new( $file{'source.tap'} ), 312 iclass => 'TAP::Parser::Iterator::Stream', 313 output => [ '1..1', 'ok 1 - source.tap' ], 314 assemble_meta => 1, 315 }, 316 ], 317 }; 318 319 test_handler( $class, $tests ); 320} 321 322############################################################################### 323# helper sub 324 325sub test_handler { 326 my ( $class, $tests ) = @_; 327 my ($short_class) = ( $class =~ /\:\:(\w+)$/ ); 328 329 use_ok $class; 330 can_ok $class, 'can_handle', 'make_iterator'; 331 332 { 333 my $default_vote = $tests->{default_vote} || 0; 334 my $source = TAP::Parser::Source->new; 335 is( $class->can_handle($source), $default_vote, 336 '... can_handle default vote' 337 ); 338 } 339 340 for my $test ( @{ $tests->{can_handle} } ) { 341 my $source = TAP::Parser::Source->new; 342 $source->raw( $test->{raw} ) if $test->{raw}; 343 $source->meta( $test->{meta} ) if $test->{meta}; 344 $source->config( $test->{config} ) if $test->{config}; 345 $source->assemble_meta if $test->{assemble_meta}; 346 my $vote = $test->{vote} || 0; 347 my $name = $test->{name} || 'unnamed test'; 348 $name = "$short_class->can_handle( $name )"; 349 is( $class->can_handle($source), $vote, $name ); 350 } 351 352 for my $test ( @{ $tests->{make_iterator} } ) { 353 my $name = $test->{name} || 'unnamed test'; 354 $name = "$short_class->make_iterator( $name )"; 355 356 SKIP: 357 { 358 my $planned = 1; 359 $planned += 1 + scalar @{ $test->{output} } if $test->{output}; 360 skip $test->{skip_reason}, $planned if $test->{skip}; 361 362 my $source = TAP::Parser::Source->new; 363 $source->raw( $test->{raw} ) if $test->{raw}; 364 $source->test_args( $test->{test_args} ) if $test->{test_args}; 365 $source->meta( $test->{meta} ) if $test->{meta}; 366 $source->config( $test->{config} ) if $test->{config}; 367 $source->assemble_meta if $test->{assemble_meta}; 368 369 my $iterator = eval { $class->make_iterator($source) }; 370 my $e = $@; 371 if ( my $error = $test->{error} ) { 372 $e = '' unless defined $e; 373 like $e, $error, "$name threw expected error"; 374 next; 375 } 376 elsif ($e) { 377 fail("$name threw an unexpected error"); 378 diag($e); 379 next; 380 } 381 382 isa_ok $iterator, $test->{iclass}, $name; 383 if ( $test->{output} ) { 384 my $i = 1; 385 for my $line ( @{ $test->{output} } ) { 386 is $iterator->next, $line, "... line $i"; 387 $i++; 388 } 389 ok !$iterator->next, '... and we should have no more results'; 390 } 391 } 392 } 393} 394