Commit | Line | Data |
b965d173 |
1 | #!/usr/bin/perl -w |
2 | |
3 | BEGIN { |
5e2a19fc |
4 | if ( $ENV{PERL_CORE} ) { |
5 | chdir 't'; |
6dcddb87 |
6 | @INC = ( '../lib', '../ext/Test/Harness/t/lib' ); |
5e2a19fc |
7 | } |
8 | else { |
9 | unshift @INC, 't/lib'; |
b965d173 |
10 | } |
11 | } |
12 | |
13 | use strict; |
b965d173 |
14 | |
f7c69158 |
15 | use Test::More tests => 26; |
b965d173 |
16 | |
17 | use File::Spec; |
18 | |
f7c69158 |
19 | use EmptyParser; |
b965d173 |
20 | use TAP::Parser::Source; |
21 | use TAP::Parser::Source::Perl; |
22 | |
f7c69158 |
23 | my $parser = EmptyParser->new; |
24 | my $test = File::Spec->catfile( |
27fc0087 |
25 | ( $ENV{PERL_CORE} |
26 | ? ( File::Spec->updir(), 'ext', 'Test', 'Harness' ) |
27 | : () |
28 | ), |
29 | 't', |
30 | 'source_tests', |
31 | 'source' |
5e2a19fc |
32 | ); |
b965d173 |
33 | |
34 | my $perl = $^X; |
35 | |
36 | can_ok 'TAP::Parser::Source', 'new'; |
37 | my $source = TAP::Parser::Source->new; |
38 | isa_ok $source, 'TAP::Parser::Source'; |
39 | |
40 | can_ok $source, 'source'; |
41 | eval { $source->source("$perl -It/lib $test") }; |
42 | ok my $error = $@, '... and calling it with a string should fail'; |
43 | like $error, qr/^Argument to &source must be an array reference/, |
44 | '... with an appropriate error message'; |
45 | ok $source->source( [ $perl, '-It/lib', '-T', $test ] ), |
46 | '... and calling it with valid args should succeed'; |
47 | |
48 | can_ok $source, 'get_stream'; |
f7c69158 |
49 | my $stream = $source->get_stream($parser); |
b965d173 |
50 | |
51 | isa_ok $stream, 'TAP::Parser::Iterator::Process', |
52 | 'get_stream returns the right object'; |
53 | can_ok $stream, 'next'; |
54 | is $stream->next, '1..1', '... and the first line should be correct'; |
55 | is $stream->next, 'ok 1', '... as should the second'; |
56 | ok !$stream->next, '... and we should have no more results'; |
57 | |
58 | can_ok 'TAP::Parser::Source::Perl', 'new'; |
59 | $source = TAP::Parser::Source::Perl->new; |
60 | isa_ok $source, 'TAP::Parser::Source::Perl', '... and the object it returns'; |
61 | |
62 | can_ok $source, 'source'; |
63 | ok $source->source( [$test] ), |
64 | '... and calling it with valid args should succeed'; |
65 | |
66 | can_ok $source, 'get_stream'; |
f7c69158 |
67 | $stream = $source->get_stream($parser); |
b965d173 |
68 | |
69 | isa_ok $stream, 'TAP::Parser::Iterator::Process', |
70 | '... and the object it returns'; |
71 | can_ok $stream, 'next'; |
72 | is $stream->next, '1..1', '... and the first line should be correct'; |
73 | is $stream->next, 'ok 1', '... as should the second'; |
74 | ok !$stream->next, '... and we should have no more results'; |
75 | |
76 | # internals tests! |
77 | |
78 | can_ok $source, '_switches'; |
79 | ok( grep( $_ =~ /^['"]?-T['"]?$/, $source->_switches ), |
80 | '... and it should find the taint switch' |
81 | ); |
82 | |
83 | # coverage test for TAP::PArser::Source |
84 | |
85 | { |
86 | |
87 | # coverage for method get_steam |
88 | |
f7c69158 |
89 | my $source = TAP::Parser::Source->new( { parser => $parser } ); |
b965d173 |
90 | |
91 | my @die; |
92 | |
93 | eval { |
94 | local $SIG{__DIE__} = sub { push @die, @_ }; |
95 | |
96 | $source->get_stream; |
97 | }; |
98 | |
99 | is @die, 1, 'coverage testing of get_stream'; |
100 | |
101 | like pop @die, qr/No command found!/, '...and it failed as expect'; |
102 | } |
103 | |