1use Test2::Bundle::Extended -target => 'Test2::Compare::Object';
2
3subtest simple => sub {
4    my $one = $CLASS->new;
5    isa_ok($one, $CLASS, 'Test2::Compare::Base');
6
7    is($one->calls, [], "got calls arrayref for free");
8
9    is($one->name, '<OBJECT>', "Got name");
10
11    is($one->meta_class, 'Test2::Compare::Meta', "Correct metaclass");
12
13    is($one->object_base, 'UNIVERSAL', "Correct object base");
14
15    ok(defined $CLASS->new(calls => []), "Can specify a calls array")
16};
17
18subtest verify => sub {
19    my $one = $CLASS->new;
20
21    ok(!$one->verify(exists => 0), "nothing to verify");
22    ok(!$one->verify(exists => 1, got => 1), "not a ref");
23    ok(!$one->verify(exists => 1, got => {}), "not blessed");
24
25    ok($one->verify(exists => 1, got => bless({}, 'Foo')), "Blessed");
26
27    no warnings 'once';
28    local *Foo::isa = sub { 0 };
29    ok(!$one->verify(exists => 1, got => bless({}, 'Foo')), "not a 'UNIVERSAL' (pretend)");
30};
31
32subtest add_prop => sub {
33    my $one = $CLASS->new();
34
35    ok(!$one->meta, "no meta yet");
36    $one->add_prop('blessed' => 'Foo');
37    isa_ok($one->meta, 'Test2::Compare::Meta');
38    is(@{$one->meta->items}, 1, "1 item");
39
40    $one->add_prop('reftype' => 'HASH');
41    is(@{$one->meta->items}, 2, "2 items");
42};
43
44subtest add_field => sub {
45    my $one = $CLASS->new();
46
47    ok(!$one->refcheck, "no refcheck yet");
48    $one->add_field(foo => 1);
49    isa_ok($one->refcheck, 'Test2::Compare::Hash');
50    is(@{$one->refcheck->order}, 1, "1 item");
51
52    $one->add_field(bar => 1);
53    is(@{$one->refcheck->order}, 2, "2 items");
54
55    $one = $CLASS->new();
56    $one->add_item(0 => 'foo');
57    like(
58        dies { $one->add_field(foo => 1) },
59        qr/Underlying reference does not have fields/,
60        "Cannot add fields to a non-hash refcheck"
61    );
62};
63
64subtest add_item => sub {
65    my $one = $CLASS->new();
66
67    ok(!$one->refcheck, "no refcheck yet");
68    $one->add_item(0 => 'foo');
69    isa_ok($one->refcheck, 'Test2::Compare::Array');
70    is(@{$one->refcheck->order}, 1, "1 item");
71
72    $one->add_item(1 => 'bar');
73    is(@{$one->refcheck->order}, 2, "2 items");
74
75    $one = $CLASS->new();
76    $one->add_field('foo' => 1);
77    like(
78        dies { $one->add_item(0 => 'foo') },
79        qr/Underlying reference does not have items/,
80        "Cannot add items to a non-array refcheck"
81    );
82};
83
84subtest add_call => sub {
85    my $one = $CLASS->new;
86
87    my $code = sub { 1 };
88
89    $one->add_call(foo => 'FOO');
90    $one->add_call($code, 1);
91    $one->add_call($code, 1, 'custom');
92    $one->add_call($code, 1, 'custom', 'list');
93
94    is(
95        $one->calls,
96        [
97            ['foo', 'FOO', 'foo',    'scalar'],
98            [$code, 1,     '\&CODE', 'scalar'],
99            [$code, 1,     'custom', 'scalar'],
100            [$code, 1,     'custom', 'list'],
101        ],
102        "Added all 4 calls"
103    );
104};
105
106{
107    package Foo;
108
109    package Foo::Bar;
110    our @ISA = 'Foo';
111
112    sub foo { 'foo' }
113    sub baz { 'baz' }
114    sub one { 1 }
115    sub many { return (1,2,3,4) }
116    sub args { shift; +{@_} }
117
118    package Fake::Fake;
119
120    sub foo { 'xxx' }
121    sub one { 2 }
122    sub args { shift; +[@_] }
123}
124
125subtest deltas => sub {
126    my $convert = Test2::Compare->can('strict_convert');
127
128    my $good = bless { a => 1 }, 'Foo::Bar';
129    my $bad  = bless [ 'a', 1 ], 'Fake::Fake';
130
131    my $one = $CLASS->new;
132    $one->add_field(a => 1);
133    $one->add_prop(blessed => 'Foo::Bar');
134    $one->add_prop(isa => 'Foo');
135
136    $one->add_call(sub {
137        my $self = shift;
138        die "XXX" unless $self->isa('Foo::Bar');
139        'live';
140    }, 'live', 'maybe_throw');
141
142    $one->add_call('foo' => 'foo');
143    $one->add_call('baz' => 'baz');
144    $one->add_call('one' => 1);
145    $one->add_call('many' => [1,2,3,4],undef,'list');
146    $one->add_call('many' => {1=>2,3=>4},undef,'hash');
147    $one->add_call([args => 1,2] => {1=>2});
148
149    is(
150        [$one->deltas(exists => 1, got => $good, convert => $convert, seen => {})],
151        [],
152        "Nothing failed"
153    );
154
155    like(
156        [$one->deltas(got => $bad, convert => $convert, seen => {})],
157        [
158            {
159                chk => T(),
160                got => 'Fake::Fake',
161                id  => ['META' => 'blessed'],
162            },
163            {
164                chk => T(),
165                got => T(),
166                id  => ['META' => 'isa'],
167            },
168            {
169                chk       => T(),
170                got       => undef,
171                id        => [METHOD => 'maybe_throw'],
172                exception => qr/XXX/,
173            },
174            {
175                chk => T(),
176                got => 'xxx',
177                id  => [METHOD => 'foo'],
178            },
179            {
180                chk => T(),
181                dne => 'got',
182                got => undef,
183                id  => [METHOD => 'baz'],
184            },
185            {
186                chk => T(),
187                got => 2,
188                id  => [METHOD => 'one'],
189            },
190            {
191                chk => T(),
192                dne => 'got',
193                got => undef,
194                id  => [METHOD => 'many'],
195            },
196            {
197                chk => T(),
198                dne => 'got',
199                got => undef,
200                id  => [METHOD => 'many'],
201            },
202            {
203                chk => T(),
204                got => [1,2],
205                id  => [METHOD => 'args'],
206            },
207            {
208                chk => T(),
209                got => [],
210                id  => [META => 'Object Ref'],
211            },
212        ],
213        "Everything failed"
214    );
215
216    # This is critical, there were a couple bugs only seen when wrapped in
217    # 'run' instead of directly calling 'deltas'
218    like(
219        [$one->run(id => undef, got => $bad, convert => $convert, seen => {})],
220        [
221            {
222                verified => 1,
223                children => [
224                    {
225                        chk => T(),
226                        got => 'Fake::Fake',
227                        id  => ['META' => 'blessed'],
228                    },
229                    {
230                        chk => T(),
231                        got => T(),
232                        id  => ['META' => 'isa'],
233                    },
234                    {
235                        chk       => T(),
236                        got       => undef,
237                        id        => [METHOD => 'maybe_throw'],
238                        exception => qr/XXX/,
239                    },
240                    {
241                        chk => T(),
242                        got => 'xxx',
243                        id  => [METHOD => 'foo'],
244                    },
245                    {
246                        chk => T(),
247                        dne => 'got',
248                        got => undef,
249                        id  => [METHOD => 'baz'],
250                    },
251                    {
252                        chk => T(),
253                        got => 2,
254                        id  => [METHOD => 'one'],
255                    },
256                    {
257                        chk => T(),
258                        dne => 'got',
259                        got => undef,
260                        id  => [METHOD => 'many'],
261                    },
262                    {
263                        chk => T(),
264                        dne => 'got',
265                        got => undef,
266                        id  => [METHOD => 'many'],
267                    },
268                    {
269                        chk => T(),
270                        got => [1,2],
271                        id  => [METHOD => 'args'],
272                    },
273                    {
274                        chk => T(),
275                        got => [],
276                        id  => [META => 'Object Ref'],
277                    },
278                ],
279            },
280        ],
281        "Everything failed, check when wrapped"
282    );
283};
284
285done_testing;
286