6 use Test::More tests => 38;
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;
28 like( $@, qr/No callbacks/, 'no callbacks allowed croaks OK' );
29 my $cb = $base->_callback_for('some_event');
30 ok( !$cb, 'no callback installed' );
35 # No callbacks allowed, constructor should croak
37 my $base = TAP::Base->new(
49 'no callbacks in constructor croaks OK'
62 $self->SUPER::_initialize( $args, [qw( nice_event other_event )] );
68 my $base = CallbackOK->new();
69 isa_ok $base, 'TAP::Base';
79 like( $@, qr/Callback some_event/, 'illegal callback croaks OK' );
81 my ( $nice, $other ) = ( 0, 0 );
84 $base->callback( other_event => sub { $other-- } );
85 $base->callback( nice_event => sub { $nice++; return shift() . 'OK' }
89 ok( !$@, 'callbacks installed OK' );
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' );
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' );
106 cmp_ok( $other, '==', -1, 'callback calls the right sub' );
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' );
114 my ( $nice, $other ) = ( 0, 0 );
116 my $base = CallbackOK->new(
118 nice_event => sub { $nice++ }
123 isa_ok $base, 'TAP::Base', 'object creation with callback succeeds';
133 like( $@, qr/Callback some_event/, 'illegal callback croaks OK' );
136 $base->callback( other_event => sub { $other-- } );
139 ok( !$@, 'callback installed OK' );
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' );
147 cmp_ok( $nice, '==', 1, 'callback calls the right sub' );
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' );
155 cmp_ok( $other, '==', -1, 'callback calls the right sub' );
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' );
163 # Stack another callback
164 $base->callback( other_event => sub { $status = 'OK'; return 'Aye' } );
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' );