lib/Test/Harness/t/callback.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 Test::More;
  14 use File::Spec;
  15
  16 my $Curdir = File::Spec->curdir;
  17 my $SAMPLE_TESTS = $ENV{PERL_CORE}
  18                     ? File::Spec->catdir($Curdir, 'lib', 'sample-tests')
  19                     : File::Spec->catdir($Curdir, 't',   'sample-tests');
  20
  21 %samples = (
  22             bailout     => [qw( header test test test bailout )],
  23             combined    => ['header', ('test') x 10],
  24             descriptive => ['header', ('test') x 5 ],
  25             duplicates  => ['header', ('test') x 11 ],
  26             head_end    => [qw( other test test test test
  27                                 other header other other )],
  28             head_fail   => [qw( other test test test test
  29                                 other header other other )],
  30             no_nums     => ['header', ('test') x 5 ],
  31             out_of_order=> [('test') x 10, 'header', ('test') x 5],
  32             simple      => [qw( header test test test test test )],
  33             simple_fail => [qw( header test test test test test )],
  34             'skip'      => [qw( header test test test test test )],
  35             skipall     => [qw( header )],
  36             skipall_nomsg => [qw( header )],
  37             skip_nomsg  => [qw( header test )],
  38             taint       => [qw( header test )],
  39             'todo'      => [qw( header test test test test test )],
  40             todo_inline => [qw( header test test test )],
  41             vms_nit     => [qw( header other test test )],
  42             with_comments => [qw( other header other test other test test
  43                                   test other other test other )],
  44            );
  45
  46 plan tests => 2 + scalar keys %samples;
  47
  48 use_ok( 'Test::Harness::Straps' );
  49 my $strap = Test::Harness::Straps->new;
  50 isa_ok( $strap, 'Test::Harness::Straps' );
  51 $strap->{callback} = sub {
  52     my($self, $line, $type, $totals) = @_;
  53     push @out, $type;
  54 };
  55
  56 while( my($test, $expect) = each %samples ) {
  57     local @out = ();
  58     $strap->analyze_file(File::Spec->catfile($SAMPLE_TESTS, $test));
  59
  60     is_deeply(\@out, $expect,   "$test callback");
  61 }