cpan/Test-Harness/t/callbacks.t

   1 #!/usr/bin/perl -wT
   2
   3 use strict;
   4 use lib 't/lib';
   5
   6 use Test::More tests => 10;
   7
   8 use TAP::Parser;
   9 use TAP::Parser::IteratorFactory;
  10
  11 my $tap = <<'END_TAP';
  12 1..5
  13 ok 1 - input file opened
  14 ... this is junk
  15 not ok first line of the input valid # todo some data
  16 # this is a comment
  17 ok 3 - read the rest of the file
  18 not ok 4 - this is a real failure
  19 ok 5 # skip we have no description
  20 END_TAP
  21
  22 my @tests;
  23 my $plan_output;
  24 my $todo      = 0;
  25 my $skip      = 0;
  26 my %callbacks = (
  27     test => sub {
  28         my $test = shift;
  29         push @tests => $test;
  30         $todo++ if $test->has_todo;
  31         $skip++ if $test->has_skip;
  32     },
  33     plan => sub {
  34         my $plan = shift;
  35         $plan_output = $plan->as_string;
  36     }
  37 );
  38
  39 my $factory = TAP::Parser::IteratorFactory->new;
  40 my $stream  = $factory->make_iterator( [ split /\n/ => $tap ] );
  41 my $parser  = TAP::Parser->new(
  42     {   stream    => $stream,
  43         callbacks => \%callbacks,
  44     }
  45 );
  46
  47 can_ok $parser, 'run';
  48 $parser->run;
  49 is $plan_output, '1..5', 'Plan callbacks should succeed';
  50 is scalar @tests, $parser->tests_run, '... as should the test callbacks';
  51
  52 @tests       = ();
  53 $plan_output = '';
  54 $todo        = 0;
  55 $skip        = 0;
  56 my $else = 0;
  57 my $all  = 0;
  58 my $end  = 0;
  59 %callbacks = (
  60     test => sub {
  61         my $test = shift;
  62         push @tests => $test;
  63         $todo++ if $test->has_todo;
  64         $skip++ if $test->has_skip;
  65     },
  66     plan => sub {
  67         my $plan = shift;
  68         $plan_output = $plan->as_string;
  69     },
  70     EOF => sub {
  71         my $p = shift;
  72         $end = 1 if $all == 8 and $p->isa('TAP::Parser');
  73     },
  74     ELSE => sub {
  75         $else++;
  76     },
  77     ALL => sub {
  78         $all++;
  79     },
  80 );
  81
  82 $stream = $factory->make_iterator( [ split /\n/ => $tap ] );
  83 $parser = TAP::Parser->new(
  84     {   stream    => $stream,
  85         callbacks => \%callbacks,
  86     }
  87 );
  88
  89 can_ok $parser, 'run';
  90 $parser->run;
  91 is $plan_output, '1..5', 'Plan callbacks should succeed';
  92 is scalar @tests, $parser->tests_run, '... as should the test callbacks';
  93 is $else, 2, '... and the correct number of "ELSE" lines should be seen';
  94 is $all,  8, '... and the correct total number of lines should be seen';
  95 is $end,  1, 'EOF callback correctly called';
  96
  97 # Check callback name policing
  98
  99 %callbacks = (
 100     sometest => sub { },
 101     plan     => sub { },
 102     random   => sub { },
 103     ALL      => sub { },
 104     ELSES    => sub { },
 105 );
 106
 107 $stream = $factory->make_iterator( [ split /\n/ => $tap ] );
 108 eval {
 109     $parser = TAP::Parser->new(
 110         {   stream    => $stream,
 111             callbacks => \%callbacks,
 112         }
 113     );
 114 };
 115
 116 like $@, qr/Callback/, 'Bad callback keys faulted';