git.maemo.org Git - pkg-perl/blob - deb-src/libtest-harness-perl/libtest-harness-perl-3.12/t/base.t

   1 #!/usr/bin/perl -wT
   2
   3 use strict;
   4 use lib 't/lib';
   5
   6 use Test::More tests => 38;
   7
   8 use TAP::Base;
   9
  10 {
  11
  12     # No callbacks allowed
  13     can_ok 'TAP::Base', 'new';
  14     my $base = TAP::Base->new();
  15     isa_ok $base, 'TAP::Base', 'object of correct type';
  16     foreach my $method (qw(callback _croak _callback_for _initialize)) {
  17         can_ok $base, $method;
  18     }
  19
  20     eval {
  21         $base->callback(
  22             some_event => sub {
  23
  24                 # do nothing
  25             }
  26         );
  27     };
  28     like( $@, qr/No callbacks/, 'no callbacks allowed croaks OK' );
  29     my $cb = $base->_callback_for('some_event');
  30     ok( !$cb, 'no callback installed' );
  31 }
  32
  33 {
  34
  35     # No callbacks allowed, constructor should croak
  36     eval {
  37         my $base = TAP::Base->new(
  38             {   callbacks => {
  39                     some_event => sub {
  40
  41                         # do nothing
  42                       }
  43                 }
  44             }
  45         );
  46     };
  47     like(
  48         $@, qr/No callbacks/,
  49         'no callbacks in constructor croaks OK'
  50     );
  51 }
  52
  53 package CallbackOK;
  54
  55 use TAP::Base;
  56 use vars qw(@ISA);
  57 @ISA = 'TAP::Base';
  58
  59 sub _initialize {
  60     my $self = shift;
  61     my $args = shift;
  62     $self->SUPER::_initialize( $args, [qw( nice_event other_event )] );
  63     return $self;
  64 }
  65
  66 package main;
  67 {
  68     my $base = CallbackOK->new();
  69     isa_ok $base, 'TAP::Base';
  70
  71     eval {
  72         $base->callback(
  73             some_event => sub {
  74
  75                 # do nothing
  76             }
  77         );
  78     };
  79     like( $@, qr/Callback some_event/, 'illegal callback croaks OK' );
  80
  81     my ( $nice, $other ) = ( 0, 0 );
  82
  83     eval {
  84         $base->callback( other_event => sub { $other-- } );
  85         $base->callback( nice_event => sub { $nice++; return shift() . 'OK' }
  86         );
  87     };
  88
  89     ok( !$@, 'callbacks installed OK' );
  90
  91     my $nice_cbs = $base->_callback_for('nice_event');
  92     is( ref $nice_cbs,     'ARRAY', 'callbacks type ok' );
  93     is( scalar @$nice_cbs, 1,       'right number of callbacks' );
  94     my $nice_cb = $nice_cbs->[0];
  95     ok( ref $nice_cb eq 'CODE', 'callback for nice_event returned' );
  96     my $got = $nice_cb->('Is ');
  97     is( $got, 'Is OK', 'args passed to callback' );
  98     cmp_ok( $nice, '==', 1, 'callback calls the right sub' );
  99
 100     my $other_cbs = $base->_callback_for('other_event');
 101     is( ref $other_cbs,     'ARRAY', 'callbacks type ok' );
 102     is( scalar @$other_cbs, 1,       'right number of callbacks' );
 103     my $other_cb = $other_cbs->[0];
 104     ok( ref $other_cb eq 'CODE', 'callback for other_event returned' );
 105     $other_cb->();
 106     cmp_ok( $other, '==', -1, 'callback calls the right sub' );
 107
 108     my @got = $base->_make_callback( 'nice_event', 'I am ' );
 109     is( scalar @got, 1,         'right number of results' );
 110     is( $got[0],     'I am OK', 'callback via _make_callback works' );
 111 }
 112
 113 {
 114     my ( $nice, $other ) = ( 0, 0 );
 115
 116     my $base = CallbackOK->new(
 117         {   callbacks => {
 118                 nice_event => sub { $nice++ }
 119             }
 120         }
 121     );
 122
 123     isa_ok $base, 'TAP::Base', 'object creation with callback succeeds';
 124
 125     eval {
 126         $base->callback(
 127             some_event => sub {
 128
 129                 # do nothing
 130             }
 131         );
 132     };
 133     like( $@, qr/Callback some_event/, 'illegal callback croaks OK' );
 134
 135     eval {
 136         $base->callback( other_event => sub { $other-- } );
 137     };
 138
 139     ok( !$@, 'callback installed OK' );
 140
 141     my $nice_cbs = $base->_callback_for('nice_event');
 142     is( ref $nice_cbs,     'ARRAY', 'callbacks type ok' );
 143     is( scalar @$nice_cbs, 1,       'right number of callbacks' );
 144     my $nice_cb = $nice_cbs->[0];
 145     ok( ref $nice_cb eq 'CODE', 'callback for nice_event returned' );
 146     $nice_cb->();
 147     cmp_ok( $nice, '==', 1, 'callback calls the right sub' );
 148
 149     my $other_cbs = $base->_callback_for('other_event');
 150     is( ref $other_cbs,     'ARRAY', 'callbacks type ok' );
 151     is( scalar @$other_cbs, 1,       'right number of callbacks' );
 152     my $other_cb = $other_cbs->[0];
 153     ok( ref $other_cb eq 'CODE', 'callback for other_event returned' );
 154     $other_cb->();
 155     cmp_ok( $other, '==', -1, 'callback calls the right sub' );
 156
 157     # my @got = $base->_make_callback( 'nice_event', 'I am ' );
 158     # is ( scalar @got, 1, 'right number of results' );
 159     # is( $got[0], 'I am OK', 'callback via _make_callback works' );
 160
 161     my $status = undef;
 162
 163     # Stack another callback
 164     $base->callback( other_event => sub { $status = 'OK'; return 'Aye' } );
 165
 166     my $new_cbs = $base->_callback_for('other_event');
 167     is( ref $new_cbs,     'ARRAY', 'callbacks type ok' );
 168     is( scalar @$new_cbs, 2,       'right number of callbacks' );
 169     my $new_cb = $new_cbs->[1];
 170     ok( ref $new_cb eq 'CODE', 'callback for new_event returned' );
 171     my @got = $new_cb->();
 172     is( $status, 'OK', 'new callback called OK' );
 173 }