t/lib/Test2/Tools/MoreCompare.pm


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

package Test2::Tools::MoreCompare; 
use strict;
use warnings;
 
use Carp qw/croak/;
use Scalar::Util qw/reftype/;
 
use Test2::API qw/context/;
use Test2::Util::Ref qw/rtype/;
 
use Test2::Compare qw{
    compare
    get_build push_build pop_build build
    strict_convert relaxed_convert
};
 
use Test2::Compare::Bag();
 
%Carp::Internal = (
    %Carp::Internal,
    'Test2::Tools::MoreCompare' => 1,
    'Test2::Compare::Bag'       => 1,
);
 
our @EXPORT_OK = qw{
    bag call_list
};
use base 'Exporter';
 
sub bag(&)  { build('Test2::Compare::Bag', @_) }
 
sub call_list($$) {
    my ($name, $expect) = @_;
    my $build = get_build() or croak "No current build!";
 
    croak "'$build' does not support method calls"
        unless $build->can('add_call');
 
    croak "'call_list' should only ever be called in void context"
        if defined wantarray;
 
    my @caller = caller;
    $build->add_call(
        sub { [ shift->$name ] },
        Test2::Compare::Wildcard->new(
            expect => $expect,
            file   => $caller[1],
            lines  => [$caller[2]],
        ),
        $name,
    );
 
}
 
1;