t/tests/morecompare.t


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
67
68
69
70
71
72
73
74

#!perl 
use strict;
use warnings;
use 5.020;
use Test2::Bundle::Extended;
use Test2::Tools::MoreCompare qw(bag call_list);
use Test2::API qw(intercept);
 
subtest simple => sub {
    imported_ok qw{bag call_list};
};
 
subtest bag => sub {
    my $empty = bag { };
 
    my $simple = bag {
        item 'a';
        item 'b';
        item 'c';
    };
 
    my $closed = array {
        item 0 => 'a';
        item 1 => 'b';
        item 2 => 'c';
        end;
    };
 
    is([], $empty, "empty array");
    is(['a'], $empty, "any array matches empty");
 
    is([qw/a b c/], $simple, "simple exact match");
    is([qw/b c a/], $simple, "simple out of order");
    is([qw/a b c d e/], $simple, "simple with extra");
    is([qw/b a d e c/], $simple, "simple with extra, out of order");
 
    is([qw/a b c/], $closed, "closed array");
 
    my $events = intercept {
        is({}, $empty);
        is(undef, $empty);
        is(1, $empty);
        is('ARRAY', $empty);
 
        is([qw/x y z/], $simple);
        is([qw/a b x/], $simple);
        is([qw/x b c/], $simple);
 
        is([qw/a b c d/], $closed);
    };
 
    @$events = grep {$_->isa('Test2::Event::Ok')} @$events;
    is(@$events, 8, "8 events");
    is($_->pass, 0, "event failed") for @$events;
};
 
subtest call_list => sub {
    my $obj = mock 'My::Class' => (
        add => [
            many => sub { return (1,2,3) },
            one => sub { 4 },
        ],
    );
 
    my $calls = object {
        call one => 4;
        call_list many => [1,2,3];
        call_list one => [4];
    };
 
    is(bless({},'My::Class'), $calls, 'call_list matches');
};
 
done_testing;