1use Test2::Tools::Defer;
2use strict;
3use warnings;
4
5# Make sure convert loads necessary modules (must do before loading the
6# extended bundle)
7BEGIN {
8    require Test2::Compare;
9    def ok => (defined Test2::Compare::convert(undef), "convert returned something to us");
10    def ok => ($INC{'Test2/Compare/Undef.pm'}, "loaded the Test2::Compare::Undef module");
11}
12
13use Test2::Bundle::Extended;
14use Test2::API qw/intercept/;
15use Data::Dumper;
16
17use Test2::Compare qw{
18    compare get_build push_build pop_build build
19    strict_convert relaxed_convert
20};
21pass "Loaded Test2::Compare";
22
23imported_ok qw{
24    compare get_build push_build pop_build build
25    strict_convert relaxed_convert
26};
27
28do_def;
29
30{
31    package Fake::Check;
32
33    sub run {
34        my $self = shift;
35        return {@_, self => $self}
36    }
37}
38
39my $check = bless {}, 'Fake::Check';
40my $convert = sub { $_[-1]->{ran}++; $_[-1] };
41my $got = compare('foo', $check, $convert);
42
43like(
44    $got,
45    {
46        self    => {ran => 1},
47        id      => undef,
48        got     => 'foo',
49        convert => sub  { $_ == $convert },
50        seen    => {},
51    },
52    "check got expected args"
53);
54
55is(get_build(), undef, "no build");
56
57like(
58    dies { pop_build(['a']) },
59    qr/INTERNAL ERROR: Attempted to pop incorrect build, have undef, tried to pop ARRAY/,
60    "Got error popping from nothing"
61);
62
63push_build(['a']);
64is(get_build(), ['a'], "pushed build");
65
66like(
67    dies { pop_build() },
68    qr/INTERNAL ERROR: Attempted to pop incorrect build, have ARRAY\(.*\), tried to pop undef/,
69    "Got error popping undef"
70);
71
72like(
73    dies { pop_build(['a']) },
74    qr/INTERNAL ERROR: Attempted to pop incorrect build, have ARRAY\(.*\), tried to pop ARRAY/,
75    "Got error popping wrong ref"
76);
77
78# Don't ever actually do this...
79ok(pop_build(get_build()), "Popped");
80
81my $inner;
82my $build = sub { build('Test2::Compare::Array', sub {
83    local $_ = 1;
84    $inner = get_build();
85}) }->();
86is($build->lines, [__LINE__ - 4, __LINE__ - 1], "got lines");
87is($build->file, __FILE__, "got file");
88
89ref_is($inner, $build, "Build was set inside block");
90
91like(
92    dies { my $x = build('Test2::Compare::Array', sub { die 'xxx' }) },
93    qr/xxx at/,
94    "re-threw exception"
95);
96
97like(
98    dies { build('Test2::Compare::Array', sub { }) },
99    qr/should not be called in void context/,
100    "You need to retain the return from build"
101);
102
103subtest convert => sub {
104    my $true  = do { bless \(my $dummy = 1), "My::Boolean" };
105    my $false = do { bless \(my $dummy = 0), "My::Boolean" };
106
107    my @sets = (
108        ['a',   'String', 'String'],
109        [undef, 'Undef', 'Undef'],
110        ['',    'String', 'String'],
111        [1,     'String', 'String'],
112        [0,     'String', 'String'],
113        [[],    'Array',  'Array'],
114        [{},    'Hash',   'Hash'],
115        [qr/x/, 'Regex',  'Pattern'],
116        [sub { 1 }, 'Ref', 'Custom'],
117        [\*STDERR, 'Ref',    'Ref'],
118        [\'foo',   'Scalar', 'Scalar'],
119        [\v1.2.3,  'Scalar', 'Scalar'],
120        [$true,    'Scalar', 'Scalar'],
121        [$false,   'Scalar', 'Scalar'],
122
123        [
124            bless({}, 'Test2::Compare::Base'),
125            'Base',
126            'Base'
127        ],
128
129        [
130            bless({expect => 'a'}, 'Test2::Compare::Wildcard'),
131            'String',
132            'String',
133        ],
134    );
135
136    for my $set (@sets) {
137        my ($item, $strict, $relaxed) = @$set;
138
139        my $name = defined $item ? "'$item'" : 'undef';
140
141        my $gs = strict_convert($item);
142        my $st = join '::', grep {$_} 'Test2::Compare', $strict;
143        ok($gs->isa($st), "$name -> $st") || diag Dumper($item);
144
145        my $gr = relaxed_convert($item);
146        my $rt = join '::', grep {$_} 'Test2::Compare', $relaxed;
147        ok($gr->isa($rt), "$name -> $rt") || diag Dumper($item);
148    }
149};
150
151done_testing;
152