lib/Test/Harness/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 => 30;
  16
  17 use File::Spec;
  18
  19 use TAP::Parser::Source;
  20 use TAP::Parser::Source::Perl;
  21
  22 my $test = File::Spec->catfile(
  23     ( $ENV{PERL_CORE} ? 'lib' : 't' ), 'source_tests',
  24     'source'
  25 );
  26
  27 my $perl = $^X;
  28
  29 can_ok 'TAP::Parser::Source', 'new';
  30 my $source = TAP::Parser::Source->new;
  31 isa_ok $source, 'TAP::Parser::Source';
  32
  33 can_ok $source, 'source';
  34 eval { $source->source("$perl -It/lib $test") };
  35 ok my $error = $@, '... and calling it with a string should fail';
  36 like $error, qr/^Argument to &source must be an array reference/,
  37   '... with an appropriate error message';
  38 ok $source->source( [ $perl, '-It/lib', '-T', $test ] ),
  39   '... and calling it with valid args should succeed';
  40
  41 can_ok $source, 'get_stream';
  42 my $stream = $source->get_stream;
  43
  44 isa_ok $stream, 'TAP::Parser::Iterator::Process',
  45   'get_stream returns the right object';
  46 can_ok $stream, 'next';
  47 is $stream->next, '1..1', '... and the first line should be correct';
  48 is $stream->next, 'ok 1', '... as should the second';
  49 ok !$stream->next, '... and we should have no more results';
  50
  51 can_ok 'TAP::Parser::Source::Perl', 'new';
  52 $source = TAP::Parser::Source::Perl->new;
  53 isa_ok $source, 'TAP::Parser::Source::Perl', '... and the object it returns';
  54
  55 can_ok $source, 'source';
  56 ok $source->source( [$test] ),
  57   '... and calling it with valid args should succeed';
  58
  59 can_ok $source, 'get_stream';
  60 $stream = $source->get_stream;
  61
  62 isa_ok $stream, 'TAP::Parser::Iterator::Process',
  63   '... and the object it returns';
  64 can_ok $stream, 'next';
  65 is $stream->next, '1..1', '... and the first line should be correct';
  66 is $stream->next, 'ok 1', '... as should the second';
  67 ok !$stream->next, '... and we should have no more results';
  68
  69 # internals tests!
  70
  71 can_ok $source, '_switches';
  72 ok( grep( $_ =~ /^['"]?-T['"]?$/, $source->_switches ),
  73     '... and it should find the taint switch'
  74 );
  75
  76 # coverage test for TAP::PArser::Source
  77
  78 {
  79
  80     # coverage for method get_steam
  81
  82     my $source = TAP::Parser::Source->new();
  83
  84     my @die;
  85
  86     eval {
  87         local $SIG{__DIE__} = sub { push @die, @_ };
  88
  89         $source->get_stream;
  90     };
  91
  92     is @die, 1, 'coverage testing of get_stream';
  93
  94     like pop @die, qr/No command found!/, '...and it failed as expect';
  95 }
  96
  97 {
  98
  99     # coverage testing for error
 100
 101     my $source = TAP::Parser::Source->new();
 102
 103     my $error = $source->error;
 104
 105     is $error, undef, 'coverage testing for error()';
 106
 107     $source->error('save me');
 108
 109     $error = $source->error;
 110
 111     is $error, 'save me', '...and we got the expected message';
 112 }
 113
 114 {
 115
 116     # coverage testing for exit
 117
 118     my $source = TAP::Parser::Source->new();
 119
 120     my $exit = $source->exit;
 121
 122     is $exit, undef, 'coverage testing for exit()';
 123
 124     $source->exit('save me');
 125
 126     $exit = $source->exit;
 127
 128     is $exit, 'save me', '...and we got the expected message';
 129 }