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