Commit | Line | Data |
b965d173 |
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; |
13287dd5 |
18 | } |
b965d173 |
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 | ); |
2fe373ce |
51 | } |
52 | |
b965d173 |
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'); |
f7c69158 |
92 | is( ref $nice_cbs, 'ARRAY', 'callbacks type ok' ); |
93 | is( scalar @$nice_cbs, 1, 'right number of callbacks' ); |
b965d173 |
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'); |
f7c69158 |
101 | is( ref $other_cbs, 'ARRAY', 'callbacks type ok' ); |
102 | is( scalar @$other_cbs, 1, 'right number of callbacks' ); |
b965d173 |
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 ' ); |
f7c69158 |
109 | is( scalar @got, 1, 'right number of results' ); |
110 | is( $got[0], 'I am OK', 'callback via _make_callback works' ); |
b965d173 |
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'); |
f7c69158 |
142 | is( ref $nice_cbs, 'ARRAY', 'callbacks type ok' ); |
143 | is( scalar @$nice_cbs, 1, 'right number of callbacks' ); |
b965d173 |
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'); |
f7c69158 |
150 | is( ref $other_cbs, 'ARRAY', 'callbacks type ok' ); |
151 | is( scalar @$other_cbs, 1, 'right number of callbacks' ); |
b965d173 |
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; |
13287dd5 |
162 | |
b965d173 |
163 | # Stack another callback |
164 | $base->callback( other_event => sub { $status = 'OK'; return 'Aye' } ); |
13287dd5 |
165 | |
b965d173 |
166 | my $new_cbs = $base->_callback_for('other_event'); |
f7c69158 |
167 | is( ref $new_cbs, 'ARRAY', 'callbacks type ok' ); |
168 | is( scalar @$new_cbs, 2, 'right number of callbacks' ); |
b965d173 |
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' ); |
2fe373ce |
173 | } |