1#!/usr/bin/perl -w 2 3BEGIN { 4 unshift @INC, 't/lib'; 5} 6 7use strict; 8use warnings; 9 10use Test::More tests => 82; 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 => '.t (no shebang)', 151 meta => { 152 is_file => 1, 153 file => { 154 lc_ext => '.t', dir => '', shebang => 'use strict;' 155 } 156 }, 157 vote => 0.8, 158 }, 159 { name => '.pl', 160 meta => { 161 is_file => 1, 162 file => { lc_ext => '.pl', dir => '' } 163 }, 164 vote => 0.9, 165 }, 166 { name => 't/.../file', 167 meta => { 168 is_file => 1, 169 file => { lc_ext => '', dir => 't' } 170 }, 171 vote => 0.75, 172 }, 173 { name => '#!...perl', 174 meta => { 175 is_file => 1, 176 file => { 177 lc_ext => '', dir => '', shebang => '#!/usr/bin/perl' 178 } 179 }, 180 vote => 0.9, 181 }, 182 { name => '#!...sh', 183 meta => { 184 is_file => 1, 185 file => { 186 lc_ext => '', dir => '', shebang => '#!/bin/sh' 187 } 188 }, 189 vote => 0.3, 190 }, 191 { name => 'use strict; # first line not shebang', 192 meta => { 193 is_file => 1, 194 file => { 195 lc_ext => '', dir => '', shebang => 'use strict;' 196 } 197 }, 198 vote => 0.25, 199 }, 200 { name => 'file default', 201 meta => { 202 is_file => 1, 203 file => { lc_ext => '', dir => '' } 204 }, 205 vote => 0.25, 206 }, 207 ], 208 make_iterator => [ 209 { name => $file{source}, 210 raw => \$file{source}, 211 iclass => 'TAP::Parser::Iterator::Process', 212 output => [ '1..1', 'ok 1 - source' ], 213 assemble_meta => 1, 214 }, 215 ], 216 }; 217 218 test_handler( $class, $tests ); 219 220 # internals tests! 221 { 222 my $source = TAP::Parser::Source->new->raw( \$file{source} ); 223 $source->assemble_meta; 224 my $iterator = $class->make_iterator($source); 225 my @command = @{ $iterator->{command} }; 226 ok( grep( $_ =~ /^['"]?-T['"]?$/, @command ), 227 '... and it should find the taint switch' 228 ); 229 } 230} 231 232# Raw TAP source tests 233{ 234 my $class = 'TAP::Parser::SourceHandler::RawTAP'; 235 my $tests = { 236 default_vote => 0, 237 can_handle => [ 238 { name => 'file', 239 meta => { is_file => 1 }, 240 raw => \'', 241 vote => 0, 242 }, 243 { name => 'scalar w/newlines', 244 raw => \"hello\nworld\n", 245 vote => 0.3, 246 assemble_meta => 1, 247 }, 248 { name => '1..10', 249 raw => \"1..10\n", 250 vote => 0.9, 251 assemble_meta => 1, 252 }, 253 { name => 'array', 254 raw => [ '1..1', 'ok 1' ], 255 vote => 0.5, 256 assemble_meta => 1, 257 }, 258 ], 259 make_iterator => [ 260 { name => 'valid scalar', 261 raw => \"1..1\nok 1 - raw\n", 262 iclass => 'TAP::Parser::Iterator::Array', 263 output => [ '1..1', 'ok 1 - raw' ], 264 assemble_meta => 1, 265 }, 266 { name => 'valid array', 267 raw => [ '1..1', 'ok 1 - raw' ], 268 iclass => 'TAP::Parser::Iterator::Array', 269 output => [ '1..1', 'ok 1 - raw' ], 270 assemble_meta => 1, 271 }, 272 ], 273 }; 274 275 test_handler( $class, $tests ); 276} 277 278# Text file TAP source tests 279{ 280 my $class = 'TAP::Parser::SourceHandler::File'; 281 my $tests = { 282 default_vote => 0, 283 can_handle => [ 284 { name => '.tap', 285 meta => { 286 is_file => 1, 287 file => { lc_ext => '.tap' } 288 }, 289 vote => 0.9, 290 }, 291 { name => '.foo with config', 292 meta => { 293 is_file => 1, 294 file => { lc_ext => '.foo' } 295 }, 296 config => { File => { extensions => ['.foo'] } }, 297 vote => 0.9, 298 }, 299 ], 300 make_iterator => [ 301 { name => $file{'source.tap'}, 302 raw => \$file{'source.tap'}, 303 iclass => 'TAP::Parser::Iterator::Stream', 304 output => [ '1..1', 'ok 1 - source.tap' ], 305 assemble_meta => 1, 306 }, 307 { name => $file{'source.1'}, 308 raw => \$file{'source.1'}, 309 config => { File => { extensions => ['.1'] } }, 310 iclass => 'TAP::Parser::Iterator::Stream', 311 output => [ '1..1', 'ok 1 - source.1' ], 312 assemble_meta => 1, 313 }, 314 ], 315 }; 316 317 test_handler( $class, $tests ); 318} 319 320# IO::Handle TAP source tests 321{ 322 my $class = 'TAP::Parser::SourceHandler::Handle'; 323 my $tests = { 324 default_vote => 0, 325 can_handle => [ 326 { name => 'glob', 327 meta => { is_glob => 1 }, 328 vote => 0.8, 329 }, 330 { name => 'IO::Handle', 331 raw => IO::Handle->new, 332 vote => 0.9, 333 assemble_meta => 1, 334 }, 335 ], 336 make_iterator => [ 337 { name => 'IO::Handle', 338 raw => IO::File->new( $file{'source.tap'} ), 339 iclass => 'TAP::Parser::Iterator::Stream', 340 output => [ '1..1', 'ok 1 - source.tap' ], 341 assemble_meta => 1, 342 }, 343 ], 344 }; 345 346 test_handler( $class, $tests ); 347} 348 349############################################################################### 350# helper sub 351 352sub test_handler { 353 my ( $class, $tests ) = @_; 354 my ($short_class) = ( $class =~ /\:\:(\w+)$/ ); 355 356 use_ok $class; 357 can_ok $class, 'can_handle', 'make_iterator'; 358 359 { 360 my $default_vote = $tests->{default_vote} || 0; 361 my $source = TAP::Parser::Source->new; 362 is( $class->can_handle($source), $default_vote, 363 '... can_handle default vote' 364 ); 365 } 366 367 for my $test ( @{ $tests->{can_handle} } ) { 368 my $source = TAP::Parser::Source->new; 369 $source->raw( $test->{raw} ) if $test->{raw}; 370 $source->meta( $test->{meta} ) if $test->{meta}; 371 $source->config( $test->{config} ) if $test->{config}; 372 $source->assemble_meta if $test->{assemble_meta}; 373 my $vote = $test->{vote} || 0; 374 my $name = $test->{name} || 'unnamed test'; 375 $name = "$short_class->can_handle( $name )"; 376 is( $class->can_handle($source), $vote, $name ); 377 } 378 379 for my $test ( @{ $tests->{make_iterator} } ) { 380 my $name = $test->{name} || 'unnamed test'; 381 $name = "$short_class->make_iterator( $name )"; 382 383 SKIP: 384 { 385 my $planned = 1; 386 $planned += 1 + scalar @{ $test->{output} } if $test->{output}; 387 skip $test->{skip_reason}, $planned if $test->{skip}; 388 389 my $source = TAP::Parser::Source->new; 390 $source->raw( $test->{raw} ) if $test->{raw}; 391 $source->test_args( $test->{test_args} ) if $test->{test_args}; 392 $source->meta( $test->{meta} ) if $test->{meta}; 393 $source->config( $test->{config} ) if $test->{config}; 394 $source->assemble_meta if $test->{assemble_meta}; 395 396 my $iterator = eval { $class->make_iterator($source) }; 397 my $e = $@; 398 if ( my $error = $test->{error} ) { 399 $e = '' unless defined $e; 400 like $e, $error, "$name threw expected error"; 401 next; 402 } 403 elsif ($e) { 404 fail("$name threw an unexpected error"); 405 diag($e); 406 next; 407 } 408 409 isa_ok $iterator, $test->{iclass}, $name; 410 if ( $test->{output} ) { 411 my $i = 1; 412 for my $line ( @{ $test->{output} } ) { 413 is $iterator->next, $line, "... line $i"; 414 $i++; 415 } 416 ok !$iterator->next, '... and we should have no more results'; 417 } 418 } 419 } 420} 421