1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
|
#!perl
use warnings;
use strict;
use Test::More tests => 20;
use Carp::Assert::More;
use Test::Exception;
my $rc = eval 'assert_isa_in(undef)';
is( $rc, undef, 'Fails the eval' );
like( $@, qr/Not enough arguments for Carp::Assert::More::assert_isa_in/, 'Prototype requires two arguments' );
dies_ok { assert_isa_in(undef, undef) } 'Dies with one undef argument';
dies_ok { assert_isa_in(bless({}, 'x'), [] ) } 'No types passed in';
dies_ok { assert_isa_in('z', []) } 'List of empty types does not allow you to pass non-objects';
lives_ok { assert_isa_in( bless({}, 'x'), [ 'x' ] ) } 'One out of one';
dies_ok { assert_isa_in( bless({}, 'x'), [ 'y' ] ) } 'Zero out of one';
lives_ok { assert_isa_in( bless({}, 'x'), [ 'y', 'x' ] ) } 'One out of two';
@y::ISA = ( 'x' );
my $x = bless {}, 'y';
isa_ok( $x, 'y', 'Verifying our assumptions' );
lives_ok { assert_isa_in( bless({}, 'y'), [ 'y' ] ) } 'Matches child class';
lives_ok { assert_isa_in( bless({}, 'y'), [ 'x' ] ) } 'Matches base class';
dies_ok { assert_isa_in( bless({}, 'x'), [ 'y' ] ) } 'Parent does not match child';
ASSERT_ISA_IN: {
package a;
sub foo {}
package main;
my $aa = bless {}, 'a';
package b;
sub foo {}
package main;
my $bb = bless {}, 'b';
package c;
sub foo {}
package main;
my $cc = bless {}, 'c';
package d;
use base 'a';
use base 'b';
use base 'c';
package main;
my $dd = bless {}, 'd';
lives_ok( sub { assert_isa_in($aa, ['a']) }, 'Basic a' );
lives_ok( sub { assert_isa_in($aa, ['a', 'b', 'c']) }, 'Basic a, b, c' );
foreach my $class ( ref $aa, ref $bb, ref $cc ) {
lives_ok( sub { assert_isa_in($dd, [$class]) }, "Inheritance for $class" );
}
my $failure_regex = qr/ssertion failed/;
foreach my $class ( ref $aa, ref $bb, ref $cc ) {
throws_ok( sub { assert_isa_in($class, ['d']) }, $failure_regex, "No backwards-inheritance for $class" );
}
};
exit 0;
|
