xref: /openbsd/gnu/usr.bin/perl/cpan/Test-Harness/t/base.t (revision d89ec533) 
1#!/usr/bin/perl -wT
2
3use strict;
4use warnings;
5use lib 't/lib';
6
7use Test::More tests => 38;
8
9use TAP::Base;
10
11{
12
13    # No callbacks allowed
14    can_ok 'TAP::Base', 'new';
15    my $base = TAP::Base->new();
16    isa_ok $base, 'TAP::Base', 'object of correct type';
17    for my $method (qw(callback _croak _callback_for _initialize)) {
18        can_ok $base, $method;
19    }
20
21    eval {
22        $base->callback(
23            some_event => sub {
24
25                # do nothing
26            }
27        );
28    };
29    like( $@, qr/No callbacks/, 'no callbacks allowed croaks OK' );
30    my $cb = $base->_callback_for('some_event');
31    ok( !$cb, 'no callback installed' );
32}
33
34{
35
36    # No callbacks allowed, constructor should croak
37    eval {
38        my $base = TAP::Base->new(
39            {   callbacks => {
40                    some_event => sub {
41
42                        # do nothing
43                      }
44                }
45            }
46        );
47    };
48    like(
49        $@, qr/No callbacks/,
50        'no callbacks in constructor croaks OK'
51    );
52}
53
54package CallbackOK;
55
56use TAP::Base;
57use base 'TAP::Base';
58
59sub _initialize {
60    my $self = shift;
61    my $args = shift;
62    $self->SUPER::_initialize( $args, [qw( nice_event other_event )] );
63    return $self;
64}
65
66package 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}
174