Add ARM files

[dh-make-perl] / dev / arm / libtest-harness-perl / libtest-harness-perl-3.12 / t / base.t

diff --git a/dev/arm/libtest-harness-perl/libtest-harness-perl-3.12/t/base.t b/dev/arm/libtest-harness-perl/libtest-harness-perl-3.12/t/base.t
new file mode 100644 (file)
index 0000000..4fee548
--- /dev/null
+++ b/dev/arm/libtest-harness-perl/libtest-harness-perl-3.12/t/base.t
@@ -0,0 +1,173 @@
+#!/usr/bin/perl -wT
+
+use strict;
+use lib 't/lib';
+
+use Test::More tests => 38;
+
+use TAP::Base;
+
+{
+
+    # No callbacks allowed
+    can_ok 'TAP::Base', 'new';
+    my $base = TAP::Base->new();
+    isa_ok $base, 'TAP::Base', 'object of correct type';
+    foreach my $method (qw(callback _croak _callback_for _initialize)) {
+        can_ok $base, $method;
+    }
+
+    eval {
+        $base->callback(
+            some_event => sub {
+
+                # do nothing
+            }
+        );
+    };
+    like( $@, qr/No callbacks/, 'no callbacks allowed croaks OK' );
+    my $cb = $base->_callback_for('some_event');
+    ok( !$cb, 'no callback installed' );
+}
+
+{
+
+    # No callbacks allowed, constructor should croak
+    eval {
+        my $base = TAP::Base->new(
+            {   callbacks => {
+                    some_event => sub {
+
+                        # do nothing
+                      }
+                }
+            }
+        );
+    };
+    like(
+        $@, qr/No callbacks/,
+        'no callbacks in constructor croaks OK'
+    );
+}
+
+package CallbackOK;
+
+use TAP::Base;
+use vars qw(@ISA);
+@ISA = 'TAP::Base';
+
+sub _initialize {
+    my $self = shift;
+    my $args = shift;
+    $self->SUPER::_initialize( $args, [qw( nice_event other_event )] );
+    return $self;
+}
+
+package main;
+{
+    my $base = CallbackOK->new();
+    isa_ok $base, 'TAP::Base';
+
+    eval {
+        $base->callback(
+            some_event => sub {
+
+                # do nothing
+            }
+        );
+    };
+    like( $@, qr/Callback some_event/, 'illegal callback croaks OK' );
+
+    my ( $nice, $other ) = ( 0, 0 );
+
+    eval {
+        $base->callback( other_event => sub { $other-- } );
+        $base->callback( nice_event => sub { $nice++; return shift() . 'OK' }
+        );
+    };
+
+    ok( !$@, 'callbacks installed OK' );
+
+    my $nice_cbs = $base->_callback_for('nice_event');
+    is( ref $nice_cbs,     'ARRAY', 'callbacks type ok' );
+    is( scalar @$nice_cbs, 1,       'right number of callbacks' );
+    my $nice_cb = $nice_cbs->[0];
+    ok( ref $nice_cb eq 'CODE', 'callback for nice_event returned' );
+    my $got = $nice_cb->('Is ');
+    is( $got, 'Is OK', 'args passed to callback' );
+    cmp_ok( $nice, '==', 1, 'callback calls the right sub' );
+
+    my $other_cbs = $base->_callback_for('other_event');
+    is( ref $other_cbs,     'ARRAY', 'callbacks type ok' );
+    is( scalar @$other_cbs, 1,       'right number of callbacks' );
+    my $other_cb = $other_cbs->[0];
+    ok( ref $other_cb eq 'CODE', 'callback for other_event returned' );
+    $other_cb->();
+    cmp_ok( $other, '==', -1, 'callback calls the right sub' );
+
+    my @got = $base->_make_callback( 'nice_event', 'I am ' );
+    is( scalar @got, 1,         'right number of results' );
+    is( $got[0],     'I am OK', 'callback via _make_callback works' );
+}
+
+{
+    my ( $nice, $other ) = ( 0, 0 );
+
+    my $base = CallbackOK->new(
+        {   callbacks => {
+                nice_event => sub { $nice++ }
+            }
+        }
+    );
+
+    isa_ok $base, 'TAP::Base', 'object creation with callback succeeds';
+
+    eval {
+        $base->callback(
+            some_event => sub {
+
+                # do nothing
+            }
+        );
+    };
+    like( $@, qr/Callback some_event/, 'illegal callback croaks OK' );
+
+    eval {
+        $base->callback( other_event => sub { $other-- } );
+    };
+
+    ok( !$@, 'callback installed OK' );
+
+    my $nice_cbs = $base->_callback_for('nice_event');
+    is( ref $nice_cbs,     'ARRAY', 'callbacks type ok' );
+    is( scalar @$nice_cbs, 1,       'right number of callbacks' );
+    my $nice_cb = $nice_cbs->[0];
+    ok( ref $nice_cb eq 'CODE', 'callback for nice_event returned' );
+    $nice_cb->();
+    cmp_ok( $nice, '==', 1, 'callback calls the right sub' );
+
+    my $other_cbs = $base->_callback_for('other_event');
+    is( ref $other_cbs,     'ARRAY', 'callbacks type ok' );
+    is( scalar @$other_cbs, 1,       'right number of callbacks' );
+    my $other_cb = $other_cbs->[0];
+    ok( ref $other_cb eq 'CODE', 'callback for other_event returned' );
+    $other_cb->();
+    cmp_ok( $other, '==', -1, 'callback calls the right sub' );
+
+    # my @got = $base->_make_callback( 'nice_event', 'I am ' );
+    # is ( scalar @got, 1, 'right number of results' );
+    # is( $got[0], 'I am OK', 'callback via _make_callback works' );
+
+    my $status = undef;
+
+    # Stack another callback
+    $base->callback( other_event => sub { $status = 'OK'; return 'Aye' } );
+
+    my $new_cbs = $base->_callback_for('other_event');
+    is( ref $new_cbs,     'ARRAY', 'callbacks type ok' );
+    is( scalar @$new_cbs, 2,       'right number of callbacks' );
+    my $new_cb = $new_cbs->[1];
+    ok( ref $new_cb eq 'CODE', 'callback for new_event returned' );
+    my @got = $new_cb->();
+    is( $status, 'OK', 'new callback called OK' );
+}