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