File Coverage

blib/lib/Test/Deep.pm
Criterion Covered Total %
statement 184 234 78.6
branch 69 84 82.1
condition 37 53 69.8
subroutine 39 39 100.0
pod 20 27 74.0
total 349 437 79.8


line stmt bran cond sub pod time code
1 39     39   2709860 use v5.10.0;
  39         523  
2 39     39   206 use strict;
  39         72  
  39         885  
3 39     39   194 use warnings;
  39         80  
  39         1733  
4              
5             package Test::Deep 1.202;
6             # ABSTRACT: Extremely flexible deep comparison
7              
8 39     39   234 use Carp qw( confess );
  39         83  
  39         2049  
9              
10 39     39   15514 use Test::Deep::Cache;
  39         103  
  39         1136  
11 39     39   15284 use Test::Deep::Stack;
  39         105  
  39         1044  
12 39     39   14938 use Test::Deep::RegexpVersion;
  39         96  
  39         1257  
13              
14             require overload;
15 39     39   224 use Scalar::Util;
  39         72  
  39         12549  
16              
17             my $Test;
18             unless (defined $Test::Deep::NoTest::NoTest)
19             {
20             # for people who want eq_deeply but not Test::Builder
21             require Test::Builder;
22             $Test = Test::Builder->new;
23             }
24              
25             our ($Stack, %Compared, $CompareCache, %WrapCache, $Shallow);
26              
27             require Exporter;
28             our @ISA = qw( Exporter );
29              
30             our $Snobby = 1; # should we compare classes?
31             our $Expects = 0; # are we comparing got vs expect or expect vs expect
32              
33             our $LeafWrapper; # to wrap simple values in a test; if not set, shallow()
34              
35             our $DNE = \"";
36             our $DNE_ADDR = Scalar::Util::refaddr($DNE);
37              
38             # if no sub name is supplied then we use the package name in lower case
39             my @constructors = (
40             All => "",
41             Any => "",
42             Array => "",
43             ArrayEach => "array_each",
44             ArrayElementsOnly => "",
45             ArrayLength => "",
46             ArrayLengthOnly => "",
47             Blessed => "",
48             Boolean => "bool",
49             Code => "",
50             Hash => "",
51             HashEach => "hash_each",
52             HashKeys => "",
53             HashKeysOnly => "",
54             Ignore => "",
55             Isa => "Isa",
56             ListMethods => "",
57             Methods => "",
58             None => "",
59             Number => "num",
60             Obj => "obj_isa",
61             RefType => "",
62             Regexp => "re",
63             RegexpMatches => "",
64             RegexpOnly => "",
65             RegexpRef => "",
66             RegexpRefOnly => "",
67             ScalarRef => "scalref",
68             ScalarRefOnly => "",
69             Shallow => "",
70             String => "str",
71             );
72              
73             my @CONSTRUCTORS_FROM_CLASSES;
74              
75             while (my ($pkg, $name) = splice @constructors, 0, 2)
76             {
77             $name = lc($pkg) unless $name;
78             my $full_pkg = "Test::Deep::$pkg";
79             my $file = "$full_pkg.pm";
80             $file =~ s#::#/#g;
81             my $sub = sub {
82 2038     2038   332942 require $file;
83 2038         7423 return $full_pkg->new(@_);
84             };
85             {
86 39     39   291 no strict 'refs';
  39         112  
  39         121484  
87             *{$name} = $sub;
88             }
89              
90             push @CONSTRUCTORS_FROM_CLASSES, $name;
91             }
92              
93             {
94             our @EXPORT_OK = qw(
95             descend render_stack cmp_details deep_diag
96             true false
97             );
98              
99             our %EXPORT_TAGS;
100             $EXPORT_TAGS{preload} = [];
101             $EXPORT_TAGS{v0} = [
102             qw(
103             Isa
104             blessed
105             obj_isa
106              
107             all any array array_each arrayelementsonly arraylength arraylengthonly
108             bag bool cmp_bag cmp_deeply cmp_methods cmp_set code eq_deeply
109             hash hash_each hashkeys hashkeysonly ignore isa listmethods methods
110             noclass none noneof num re reftype regexpmatches regexponly regexpref
111             regexprefonly scalarrefonly scalref set shallow str subbagof subhashof
112             subsetof superbagof superhashof supersetof useclass
113             )
114             ];
115              
116             $EXPORT_TAGS{v1} = [
117             qw(
118             obj_isa
119              
120             all any array array_each arrayelementsonly arraylength arraylengthonly
121             bag bool cmp_bag cmp_deeply cmp_methods cmp_set code eq_deeply
122             hash hash_each hashkeys hashkeysonly ignore listmethods methods
123             noclass none noneof num re reftype regexpmatches regexponly regexpref
124             regexprefonly scalarrefonly scalref set shallow str subbagof subhashof
125             subsetof superbagof superhashof supersetof useclass
126             )
127             ];
128              
129             our @EXPORT = @{ $EXPORT_TAGS{ v0 } };
130              
131             $EXPORT_TAGS{all} = [ @EXPORT, @EXPORT_OK ];
132             }
133              
134             sub import {
135 42     42   65808 my $self = shift;
136              
137 42         111 my $from_notest = grep {$_ eq '_notest'} @_;
  11         29  
138 42 100       143 if ($from_notest) {
139 3         5 @_ = grep {$_ ne '_notest'} @_;
  3         9  
140             } else {
141 39         216 require Test::Builder;
142 39         147 $Test = Test::Builder->new;
143             }
144              
145 42         183 my @sans_preload = grep {; $_ ne ':preload' } @_;
  8         19  
146 42 50       150 if (@_ != @sans_preload) {
147 0         0 require Test::Deep::All;
148 0         0 require Test::Deep::Any;
149 0         0 require Test::Deep::Array;
150 0         0 require Test::Deep::ArrayEach;
151 0         0 require Test::Deep::ArrayElementsOnly;
152 0         0 require Test::Deep::ArrayLength;
153 0         0 require Test::Deep::ArrayLengthOnly;
154 0         0 require Test::Deep::Blessed;
155 0         0 require Test::Deep::Boolean;
156 0         0 require Test::Deep::Cache::Simple;
157 0         0 require Test::Deep::Cache;
158 0         0 require Test::Deep::Class;
159 0         0 require Test::Deep::Cmp;
160 0         0 require Test::Deep::Code;
161 0         0 require Test::Deep::Hash;
162 0         0 require Test::Deep::HashEach;
163 0         0 require Test::Deep::HashElements;
164 0         0 require Test::Deep::HashKeys;
165 0         0 require Test::Deep::HashKeysOnly;
166 0         0 require Test::Deep::Ignore;
167 0         0 require Test::Deep::Isa;
168 0         0 require Test::Deep::ListMethods;
169 0         0 require Test::Deep::Methods;
170 0         0 require Test::Deep::MM;
171 0         0 require Test::Deep::None;
172 0         0 require Test::Deep::Number;
173 0         0 require Test::Deep::Obj;
174 0         0 require Test::Deep::Ref;
175 0         0 require Test::Deep::RefType;
176 0         0 require Test::Deep::Regexp;
177 0         0 require Test::Deep::RegexpMatches;
178 0         0 require Test::Deep::RegexpOnly;
179 0         0 require Test::Deep::RegexpRef;
180 0         0 require Test::Deep::RegexpRefOnly;
181 0         0 require Test::Deep::RegexpVersion;
182 0         0 require Test::Deep::ScalarRef;
183 0         0 require Test::Deep::ScalarRefOnly;
184 0         0 require Test::Deep::Set;
185 0         0 require Test::Deep::Shallow;
186 0         0 require Test::Deep::Stack;
187 0         0 require Test::Deep::String;
188             }
189              
190 42         20315 $self->export_to_level(1, $self, @_);
191             }
192              
193             # this is ugly, I should never have exported a sub called isa now I
194             # have to try figure out if the recipient wanted my isa or if a class
195             # imported us and UNIVERSAL::isa is being called on that class.
196             # Luckily our isa always expects 1 argument and U::isa always expects
197             # 2, so we can figure out (assuming the caller is not buggy).
198             sub isa
199             {
200 14 100   14 1 13920 if (@_ == 1)
201             {
202 6         21 goto &Isa;
203             }
204             else
205             {
206 8         48 goto &UNIVERSAL::isa;
207             }
208             }
209              
210             sub cmp_deeply
211             {
212 221     221 1 88592 my ($d1, $d2, $name) = @_;
213              
214 221         542 my ($ok, $stack) = cmp_details($d1, $d2);
215              
216 220 100       997 if (not $Test->ok($ok, $name))
217             {
218 118         45672 my $diag = deep_diag($stack);
219 118         462 $Test->diag($diag);
220             }
221              
222 220         60495 return $ok;
223             }
224              
225             sub cmp_details
226             {
227 456     456 1 805 my ($d1, $d2) = @_;
228              
229 456         1540 local $Stack = Test::Deep::Stack->new;
230 456         1324 local $CompareCache = Test::Deep::Cache->new;
231 456         766 local %WrapCache;
232              
233 456         911 my $ok = descend($d1, $d2);
234              
235 455         2908 return ($ok, $Stack);
236             }
237              
238             sub eq_deeply
239             {
240 235     235 1 1731 my ($d1, $d2) = @_;
241              
242 235         424 my ($ok) = cmp_details($d1, $d2);
243              
244 235         1492 return $ok
245             }
246              
247             sub eq_deeply_cache
248             {
249             # this is like cross between eq_deeply and descend(). It doesn't start
250             # with a new $CompareCache but if the comparison fails it will leave
251             # $CompareCache as if nothing happened. However, if the comparison
252             # succeeds then $CompareCache retains all the new information
253              
254             # this allows Set and Bag to handle circular refs
255              
256 432     432 0 792 my ($d1, $d2, $name) = @_;
257              
258 432         874 local $Stack = Test::Deep::Stack->new;
259 432         1013 $CompareCache->local;
260              
261 432         830 my $ok = descend($d1, $d2);
262              
263 432         1102 $CompareCache->finish($ok);
264              
265 432         1657 return $ok;
266             }
267              
268             sub deep_diag
269             {
270 118     118 1 235 my $stack = shift;
271             # ick! incArrow and other things expect the stack has to be visible
272             # in a well known place . TODO clean this up
273 118         209 local $Stack = $stack;
274              
275 118         303 my $where = render_stack('$data', $stack);
276              
277 118 50       381 confess "No stack to diagnose" unless $stack;
278 118         323 my $last = $stack->getLast;
279              
280 118         429 my $diag;
281             my $message;
282 118         0 my $got;
283 118         0 my $expected;
284              
285 118         211 my $exp = $last->{exp};
286 118 50       466 if (Scalar::Util::blessed($exp))
287             {
288 118 100       752 if ($exp->can("diagnostics"))
289             {
290 33         114 $diag = $exp->diagnostics($where, $last);
291 33         227 $diag =~ s/\n+$/\n/;
292             }
293             else
294             {
295 85 100       390 if ($exp->can("diag_message"))
296             {
297 27         89 $message = $exp->diag_message($where);
298             }
299             }
300             }
301              
302 118 100       358 if (not defined $diag)
303             {
304 85   33     472 $got //= $exp->renderGot($last->{got});
305 85   33     500 $expected //= $exp->renderExp;
306 85   66     415 $message //= "Compared $where";
307              
308 85         327 $diag = <
309             $message
310             got : $got
311             expect : $expected
312             EOM
313             }
314              
315 118         326 return $diag;
316             }
317              
318             sub render_val
319             {
320 248     248 0 388 my $val = shift;
321              
322 248         337 my $rendered;
323 248 100       462 if (defined $val)
324             {
325 234 100       675 $rendered = ref($val) ?
    100          
326             (Scalar::Util::refaddr($val) eq $DNE_ADDR ?
327             "Does not exist" :
328             overload::StrVal($val)
329             ) :
330             qq('$val');
331             }
332             else
333             {
334 14         24 $rendered = "undef";
335             }
336              
337 248         1078 return $rendered;
338             }
339              
340             sub descend
341             {
342 2550     2550 0 4646 my ($d1, $d2) = @_;
343              
344 2550 100 100     7192 if (!ref $d1 and !ref $d2)
345             {
346             # Shortcut comparison for the non-reference case.
347 621 100       1057 if (defined $d1)
348             {
349 614 100 100     2225 return 1 if defined $d2 and $d1 eq $d2;
350             }
351             else
352             {
353 7 100       22 return 1 if !defined $d2;
354             }
355             }
356              
357 2275 100 100     8454 if (! $Expects and Scalar::Util::blessed($d1) and $d1->isa("Test::Deep::Cmp"))
      100        
358             {
359 1         4 my $where = $Stack->render('$data');
360 1         198 confess "Found a special comparison in $where\nYou can only use specials in the expects structure";
361             }
362              
363 2274 100 100     6030 if (ref $d1 and ref $d2)
364             {
365             # this check is only done when we're comparing 2 expecteds against each
366             # other
367              
368 1188 100 100     2670 if ($Expects and Scalar::Util::blessed($d1) and $d1->isa("Test::Deep::Cmp"))
      66        
369             {
370             # check they are the same class
371 18 100       59 return 0 unless Test::Deep::blessed(Scalar::Util::blessed($d2))->descend($d1);
372 15 100       95 if ($d1->can("compare"))
373             {
374 14         37 return $d1->compare($d2);
375             }
376             }
377              
378 1171         2124 my $s1 = Scalar::Util::refaddr($d1);
379 1171         1876 my $s2 = Scalar::Util::refaddr($d2);
380              
381 1171 100       2490 if ($s1 eq $s2)
382             {
383 3         8 return 1;
384             }
385 1168 100       2999 if ($CompareCache->cmp($d1, $d2))
386             {
387             # we've tried comparing these already so either they turned out to
388             # be the same or we must be in a loop and we have to assume they're
389             # the same
390              
391 34         81 return 1;
392             }
393             else
394             {
395 1134         2440 $CompareCache->add($d1, $d2)
396             }
397             }
398              
399 2220         4422 $d2 = wrap($d2);
400              
401 2220         8623 $Stack->push({exp => $d2, got => $d1});
402              
403 2220 100 100     6947 if (ref($d1) and (Scalar::Util::refaddr($d1) == $DNE_ADDR))
404             {
405             # whatever it was supposed to be, it didn't exist and so it's an
406             # automatic fail
407 5         28 return 0;
408             }
409              
410 2215 100       5267 if ($d2->descend($d1))
411             {
412             # print "d1 = $d1, d2 = $d2\nok\n";
413 1287         3177 $Stack->pop;
414              
415 1287         4562 return 1;
416             }
417             else
418             {
419             # print "d1 = $d1, d2 = $d2\nnot ok\n";
420 926         2213 return 0;
421             }
422             }
423              
424             sub wrap
425             {
426 2236     2236 0 3091 my $data = shift;
427              
428 2236         4744 my $class = Scalar::Util::blessed($data);
429 2236 100 100     9666 return $data if defined $class and $data->isa("Test::Deep::Cmp");
430              
431 627 50 66     1413 if (defined $class and $data->can('as_test_deep_cmp')) {
432 0         0 my $cmp = $data->as_test_deep_cmp;
433 0 0       0 return $cmp if $cmp->isa('Test::Deep::Cmp');
434 0         0 Carp::confess("object in expected structure provides as_test_deep_cmp but it did not return a Test::Deep::Cmp");
435             }
436              
437 627         1053 my $reftype = _td_reftype($data);
438              
439 627         894 my $cmp;
440              
441 627 100       1236 if($reftype eq '')
442             {
443 397 100       814 $cmp = $Test::Deep::LeafWrapper
444             ? $Test::Deep::LeafWrapper->($data)
445             : shallow($data);
446             }
447             else
448             {
449 230         441 my $addr = Scalar::Util::refaddr($data);
450              
451 230 100       631 return $WrapCache{$addr} if $WrapCache{$addr};
452              
453 190 100 100     512 if($reftype eq 'ARRAY')
    100 33        
    100          
    50          
454             {
455 139         279 $cmp = array($data);
456             }
457             elsif($reftype eq 'HASH')
458             {
459 28         68 $cmp = hash($data);
460             }
461             elsif($reftype eq 'SCALAR' or $reftype eq 'REF')
462             {
463 21         52 $cmp = scalref($data);
464             }
465             elsif(($reftype eq 'Regexp') or ($reftype eq 'REGEXP'))
466             {
467 2         4 $cmp = regexpref($data);
468             }
469             else
470             {
471 0 0       0 $cmp = $Test::Deep::LeafWrapper
472             ? $Test::Deep::LeafWrapper->($data)
473             : shallow($data);
474             }
475              
476 190         469 $WrapCache{$addr} = $cmp;
477             }
478 587         1079 return $cmp;
479             }
480              
481             sub _td_reftype
482             {
483 630     630   2285 my $val = shift;
484              
485 630         1186 my $reftype = Scalar::Util::reftype($val);
486 630 100       1764 return '' unless defined $reftype;
487              
488 233 50       706 return $reftype unless $Test::Deep::RegexpVersion::OldStyle;
489              
490 0         0 my $blessed = Scalar::Util::blessed($val);
491 0 0       0 return $reftype unless defined $blessed;
492              
493 0 0 0     0 if ($blessed && $blessed eq "Regexp" and $reftype eq "SCALAR")
      0        
494             {
495 0         0 $reftype = "Regexp"
496             }
497              
498 0         0 return $reftype;
499             }
500              
501             sub render_stack
502             {
503 118     118 0 268 my ($var, $stack) = @_;
504              
505 118         411 return $stack->render($var);
506             }
507              
508             sub cmp_methods
509             {
510 2     2 1 5018 local $Test::Builder::Level = $Test::Builder::Level + 1;
511 2         5 return cmp_deeply(shift, methods(@{shift()}), shift);
  2         6  
512             }
513              
514             sub requireclass
515             {
516 1     1 0 3174 require Test::Deep::Class;
517              
518 1         4 my $val = shift;
519              
520 1         34 return Test::Deep::Class->new(1, $val);
521             }
522              
523             # docs and export say this is called useclass, doh!
524              
525             *useclass = \&requireclass;
526              
527             sub noclass
528             {
529 4     4 1 7616 require Test::Deep::Class;
530              
531 4         9 my $val = shift;
532              
533 4         22 return Test::Deep::Class->new(0, $val);
534             }
535              
536             sub set
537             {
538 23     23 1 36581 require Test::Deep::Set;
539              
540 23         101 return Test::Deep::Set->new(1, "", @_);
541             }
542              
543             sub supersetof
544             {
545 2     2 1 8815 require Test::Deep::Set;
546              
547 2         9 return Test::Deep::Set->new(1, "sup", @_);
548             }
549              
550             sub subsetof
551             {
552 2     2 1 6433 require Test::Deep::Set;
553              
554 2         11 return Test::Deep::Set->new(1, "sub", @_);
555             }
556              
557             sub noneof
558             {
559 4     4 1 11522 require Test::Deep::Set;
560              
561 4         20 return Test::Deep::Set->new(1, "none", @_);
562             }
563              
564             sub cmp_set
565             {
566 2     2 1 6161 local $Test::Builder::Level = $Test::Builder::Level + 1;
567 2         5 return cmp_deeply(shift, set(@{shift()}), shift);
  2         7  
568             }
569              
570             sub bag
571             {
572 21     21 1 21940 require Test::Deep::Set;
573              
574 21         86 return Test::Deep::Set->new(0, "", @_);
575             }
576              
577             sub superbagof
578             {
579 2     2 1 5180 require Test::Deep::Set;
580              
581 2         9 return Test::Deep::Set->new(0, "sup", @_);
582             }
583              
584             sub subbagof
585             {
586 2     2 1 5108 require Test::Deep::Set;
587              
588 2         10 return Test::Deep::Set->new(0, "sub", @_);
589             }
590              
591             sub cmp_bag
592             {
593 5     5 1 12397 local $Test::Builder::Level = $Test::Builder::Level + 1;
594 5   50     20 my $ref = ref($_[1]) || "";
595 5 100       17 confess "Argument 2 to cmp_bag is not an ARRAY ref (".render_val($_[1]).")"
596             unless $ref eq "ARRAY";
597 4         8 return cmp_deeply(shift, bag(@{shift()}), shift);
  4         11  
598             }
599              
600             sub superhashof
601             {
602 1     1 1 3782 require Test::Deep::Hash;
603              
604 1         5 my $val = shift;
605              
606 1         8 return Test::Deep::SuperHash->new($val);
607             }
608              
609             sub subhashof
610             {
611 1     1 1 3757 require Test::Deep::Hash;
612              
613 1         2 my $val = shift;
614              
615 1         8 return Test::Deep::SubHash->new($val);
616             }
617              
618             sub true
619             {
620 4     4 1 10 bool(1);
621             }
622              
623             sub false
624             {
625 5     5 1 26 bool(0);
626             }
627              
628             sub builder
629             {
630 34 50   34 0 749 if (@_)
631             {
632 34         74 $Test = shift;
633             }
634 34         71 return $Test;
635             }
636              
637             1;
638              
639             =pod
640              
641             =encoding UTF-8
642              
643             =head1 NAME
644              
645             Test::Deep - Extremely flexible deep comparison
646              
647             =head1 VERSION
648              
649             version 1.202
650              
651             =head1 SYNOPSIS
652              
653             use Test::More tests => $Num_Tests;
654             use Test::Deep;
655              
656             cmp_deeply(
657             $actual_horrible_nested_data_structure,
658             $expected_horrible_nested_data_structure,
659             "got the right horrible nested data structure"
660             );
661              
662             cmp_deeply(
663             $object,
664             methods(name => "John", phone => "55378008"),
665             "object methods ok"
666             );
667              
668             cmp_deeply(
669             \@array,
670             [$hash1, $hash2, ignore()],
671             "first 2 elements are as expected, ignoring 3"
672             );
673              
674             cmp_deeply(
675             $object,
676             noclass({value => 5}),
677             "object looks ok, not checking its class"
678             );
679              
680             cmp_deeply(
681             \@result,
682             bag('a', 'b', {key => [1, 2]}),
683             "array has the 3 things we wanted in some order"
684             );
685              
686             =head1 DESCRIPTION
687              
688             If you don't know anything about automated testing in Perl then you should
689             probably read about L and L before preceding.
690             Test::Deep uses the L framework.
691              
692             Test::Deep gives you very flexible ways to check that the result you got is
693             the result you were expecting. At its simplest it compares two structures
694             by going through each level, ensuring that the values match, that arrays and
695             hashes have the same elements and that references are blessed into the
696             correct class. It also handles circular data structures without getting
697             caught in an infinite loop.
698              
699             Where it becomes more interesting is in allowing you to do something besides
700             simple exact comparisons. With strings, the C operator checks that 2
701             strings are exactly equal but sometimes that's not what you want. When you
702             don't know exactly what the string should be but you do know some things
703             about how it should look, C is no good and you must use pattern matching
704             instead. Test::Deep provides pattern matching for complex data structures
705              
706             Test::Deep has B> of exports. See L below.
707              
708             =head1 PERL VERSION
709              
710             This library should run on perls released even a long time ago. It should work
711             on any version of perl released in the last five years.
712              
713             Although it may work on older versions of perl, no guarantee is made that the
714             minimum required version will not be increased. The version may be increased
715             for any reason, and there is no promise that patches will be accepted to lower
716             the minimum required perl.
717              
718             =head1 EXAMPLES
719              
720             How Test::Deep works is much easier to understand by seeing some examples.
721              
722             =head2 Without Test::Deep
723              
724             Say you want to test a function which returns a string. You know that your
725             string should be a 7 digit number beginning with 0, C is no good in this
726             situation, you need a regular expression. So you could use Test::More's
727             C function:
728              
729             like($string, qr/^0[0-9]{6}$/, "number looks good");
730              
731             Similarly, to check that a string looks like a name, you could do:
732              
733             like($string, qr/^(Mr|Mrs|Miss) \w+ \w+$/,
734             "got title, first and last name");
735              
736             Now imagine your function produces a hash with some personal details in it.
737             You want to make sure that there are 2 keys, Name and Phone and that the
738             name looks like a name and the phone number looks like a phone number. You
739             could do:
740              
741             $hash = make_person();
742             like($hash->{Name}, qr/^(Mr|Mrs|Miss) \w+ \w+$/, "name ok");
743             like($hash->{Phone}, qr/^0[0-9]{6}$/, "phone ok");
744             is(scalar keys %$hash, 2, "correct number of keys");
745              
746             But that's not quite right, what if make_person has a serious problem and
747             didn't even return a hash? We really need to write
748              
749             if (ref($hash) eq "HASH")
750             {
751             like($hash->{Name}, qr/^(Mr|Mrs|Miss) \w+ \w+$/, "name ok");
752             like($hash->{Phone}, qr/^0[0-9]{6}$/, "phone ok");
753             is(scalar keys %$hash, 2, "correct number of keys");
754             }
755             else
756             {
757             fail("person not a hash");
758             fail("person not a hash");
759             fail("person not a hash"); # need 3 to keep the plan correct
760             }
761              
762             Already this is getting messy, now imagine another entry in the hash, an
763             array of children's names. This would require
764              
765             if (ref($hash) eq "HASH")
766             {
767             like($hash->{Name}, $name_pat, "name ok");
768             like($hash->{Phone}, '/^0d{6}$/', "phone ok");
769             my $cn = $hash->{ChildNames};
770             if (ref($cn) eq "ARRAY")
771             {
772             foreach my $child (@$cn)
773             {
774             like($child, $name_pat);
775             }
776             }
777             else
778             {
779             fail("child names not an array")
780             }
781             }
782             else
783             {
784             fail("person not a hash");
785             }
786              
787             This is a horrible mess and because we don't know in advance how many
788             children's names there will be, we can't make a plan for our test anymore
789             (actually, we could but it would make things even more complicated).
790              
791             Test::Deep to the rescue.
792              
793             =head2 With Test::Deep
794              
795             my $name_re = re('^(Mr|Mrs|Miss) \w+ \w+$');
796             cmp_deeply(
797             $person,
798             {
799             Name => $name_re,
800             Phone => re('^0d{6}$'),
801             ChildNames => array_each($name_re)
802             },
803             "person ok"
804             );
805              
806             This will do everything that the messy code above does and it will give a
807             sensible message telling you exactly what went wrong if it finds a part of
808             $person that doesn't match the pattern. C and C are
809             special function imported from Test::Deep. They create a marker that tells
810             Test::Deep that something different is happening here. Instead of just doing
811             a simple comparison and checking are two things exactly equal, it should do
812             something else.
813              
814             If a person was asked to check that 2 structures are equal, they could print
815             them both out and compare them line by line. The markers above are similar
816             to writing a note in red pen on one of the printouts telling the person that
817             for this piece of the structure, they should stop doing simple line by line
818             comparison and do something else.
819              
820             C means that Test::Deep should check that the current piece of
821             data matches the regex in C<$regex>. C means that
822             Test::Deep should expect the current piece of data to be an array and it
823             should check that every element of that array matches C<$struct>.
824             In this case, every element of C<< $person->{ChildNames} >> should look like a
825             name. If say the 3rd one didn't you would get an error message something
826             like
827              
828             Using Regexp on $data->{ChildNames}[3]
829             got : 'Queen John Paul Sartre'
830             expect : /^(Mr|Mrs|Miss) \w+ \w+$/
831              
832             There are lots of other special comparisons available, see
833             L below for the full list.
834              
835             =head2 Reusing structures
836              
837             Test::Deep is good for reusing test structures so you can do this
838              
839             my $name_re = re('^(Mr|Mrs|Miss) \w+ \w+$');
840             my $person_cmp = {
841             Name => $name_re,
842             Phone => re('^0d{6}$'),
843             ChildNames => array_each($name_re)
844             };
845              
846             cmp_deeply($person1, $person_cmp, "person ok");
847             cmp_deeply($person2, $person_cmp, "person ok");
848             cmp_deeply($person3, $person_cmp, "person ok");
849              
850             You can even put $person_cmp in a module and let other people use it when
851             they are writing test scripts for modules that use your modules.
852              
853             To make things a little more difficult, lets change the person data
854             structure so that instead of a list of ChildNames, it contains a list of
855             hashes, one for each child. So in fact our person structure will contain
856             other person structures which may contain other person structures and so on.
857             This is easy to handle with Test::Deep because Test::Deep structures can
858             include themselves. Simply do
859              
860             my $name_re = re('^(Mr|Mrs|Miss) \w+ \w+$');
861             my $person_cmp = {
862             Name => $name_re,
863             Phone => re('^0d{6}$'),
864             # note no mention of Children here
865             };
866              
867             $person_cmp->{Children} = array_each($person_cmp);
868              
869             cmp_deeply($person, $person_cmp, "person ok");
870              
871             This will now check that $person->{Children} is an array and that every
872             element of that array also matches C<$person_cmp>, this includes checking
873             that its children also match the same pattern and so on.
874              
875             =head2 Circular data structures
876              
877             A circular data structure is one which loops back on itself, you can make
878             one easily by doing
879              
880             my @b;
881             my @a = (1, 2, 3, \@b);
882             push(@b, \@a);
883              
884             now C<@a> contains a reference to be C<@b> and C<@b> contains a reference to
885             C<@a>. This causes problems if you have a program that wants to look inside
886             C<@a> and keep looking deeper and deeper at every level, it could get caught
887             in an infinite loop looking into C<@a> then C<@b> then C<@a> then C<@b> and
888             so on.
889              
890             Test::Deep avoids this problem so we can extend our example further by
891             saying that a person should also list their parents.
892              
893             my $name_re = re('^(Mr|Mrs|Miss) \w+ \w+$');
894             my $person_cmp = {
895             Name => $name_re,
896             Phone => re('^0d{6}$'),
897             # note no mention of Children here
898             };
899              
900             $person_cmp->{Children} = each_array($person_cmp);
901             $person_cmp->{Parents} = each_array($person_cmp);
902              
903             cmp_deeply($person, $person_cmp, "person ok");
904              
905             So this will check that for each child C<$child> in C<< $person->{Children} >>
906             that the C<< $child->{Parents} >> matches C<$person_cmp> however it is smart
907             enough not to get caught in an infinite loop where it keeps bouncing between
908             the same Parent and Child.
909              
910             =head1 TERMINOLOGY
911              
912             C takes 3 arguments. C<$got> is the
913             structure that you are checking, you must not include any special
914             comparisons in this structure or you will get a fatal error. C<$expected>
915             describes what Test::Deep will be looking for in $got. You can put special
916             comparisons in $expected if you want to.
917              
918             As Test::Deep descends through the 2 structures, it compares them one piece
919             at a time, so at any point in the process, Test::Deep is thinking about 2
920             things - the current value from C<$got> and the current value from
921             C<$expected>. In the documentation, I call them C<$got_v> and C
922             respectively.
923              
924             =head1 COMPARISON FUNCTIONS
925              
926             =head3 cmp_deeply
927              
928             my $ok = cmp_deeply($got, $expected, $name)
929              
930             C<$got> is the result to be checked. C<$expected> is the structure against
931             which C<$got> will be check. C<$name> is the test name.
932              
933             This is the main comparison function, the others are just wrappers around
934             this. C<$got> and C<$expected> are compared recursively. Each value in
935             C<$expected> defines what's expected at the corresponding location in C<$got>.
936             Simple scalars are compared with C. References to structures like hashes
937             and arrays are compared recursively.
938              
939             Items in C<$expected>, though, can also represent complex tests that check for
940             numbers in a given range, hashes with at least a certain set of keys, a string
941             matching a regex, or many other things.
942              
943             See L for details.
944              
945             =head3 cmp_bag
946              
947             my $ok = cmp_bag(\@got, \@bag, $name)
948              
949             Is shorthand for cmp_deeply(\@got, bag(@bag), $name)
950              
951             I: Both arguments must be array refs. If they aren't an exception will be
952             thrown.
953              
954             =head3 cmp_set
955              
956             my $ok = cmp_set(\@got, \@set, $name)
957              
958             Is shorthand for cmp_deeply(\@got, set(@set), $name)
959              
960             =head3 cmp_methods
961              
962             my $ok = cmp_methods(\@got, \@methods, $name)
963              
964             Is shorthand for cmp_deeply(\@got, methods(@methods), $name)
965              
966             =head3 eq_deeply
967              
968             my $ok = eq_deeply($got, $expected)
969              
970             This is the same as cmp_deeply() except it just returns true or
971             false. It does not create diagnostics or talk to L, but
972             if you want to use it in a non-testing environment then you should
973             import it through L. For example
974              
975             use Test::Deep::NoTest;
976             print "a equals b" unless eq_deeply($a, $b);
977              
978             otherwise the L framework will be loaded and testing messages
979             will be output when your program ends.
980              
981             =head3 cmp_details
982              
983             ($ok, $stack) = cmp_details($got, $expected)
984              
985             This behaves much like eq_deeply, but it additionally allows you to
986             produce diagnostics in case of failure by passing the value in C<$stack>
987             to C.
988              
989             Do not make assumptions about the structure or content of C<$stack> and
990             do not use it if C<$ok> contains a true value.
991              
992             See L for example uses.
993              
994             =head1 SPECIAL COMPARISONS PROVIDED
995              
996             In the documentation below, C<$got_v> is used to indicate any given value
997             within the C<$got> structure.
998              
999             =head3 ignore
1000              
1001             cmp_deeply( $got, ignore() );
1002              
1003             This makes Test::Deep skip tests on C<$got_v>. No matter what value C<$got_v>
1004             has, Test::Deep will think it's correct. This is useful if some part of the
1005             structure you are testing is very complicated and already tested elsewhere,
1006             or if it is unpredictable.
1007              
1008             cmp_deeply(
1009             $got,
1010             {
1011             name => 'John',
1012             random => ignore(),
1013             address => [ '5 A street', 'a town', 'a country' ],
1014             }
1015             );
1016              
1017             is the equivalent of checking
1018              
1019             $got->{name} eq 'John';
1020             exists $got->{random};
1021             cmp_deeply($got->{address}, ['5 A street', 'a town', 'a country']);
1022              
1023             =head3 methods
1024              
1025             cmp_deeply( $got, methods(%hash) );
1026              
1027             %hash is a hash of method call => expected value pairs.
1028              
1029             This lets you call methods on an object and check the result of each call.
1030             The methods will be called in the order supplied. If you want to pass
1031             arguments to the method you should wrap the method name and arguments in an
1032             array reference.
1033              
1034             cmp_deeply(
1035             $obj,
1036             methods(name => "John", ["favourite", "food"] => "taco")
1037             );
1038              
1039             is roughly the equivalent of checking that
1040              
1041             $obj->name eq "John"
1042             $obj->favourite("food") eq "taco"
1043              
1044             The methods will be called in the order you supply them and will be called
1045             in scalar context. If you need to test methods called in list context then
1046             you should use C.
1047              
1048             B Just as in a normal test script, you need to be careful if the
1049             methods you call have side effects like changing the object or other objects
1050             in the structure. Although the order of the methods is fixed, the order of
1051             some other tests is not so if C<$expected> is
1052              
1053             {
1054             manager => methods(@manager_methods),
1055             coder => methods(@coder_methods)
1056             }
1057              
1058             there is no way to know which if manager and coder will be tested first. If
1059             the methods you are testing depend on and alter global variables or if
1060             manager and coder are the same object then you may run into problems.
1061              
1062             =head3 listmethods
1063              
1064             cmp_deeply( $got, listmethods(%hash) );
1065              
1066             C<%hash> is a hash of pairs mapping method names to expected return values.
1067              
1068             This is almost identical to methods() except the methods are called in list
1069             context instead of scalar context. This means that the expected return
1070             values supplied must be in array references.
1071              
1072             cmp_deeply(
1073             $obj,
1074             listmethods(
1075             name => [ "John" ],
1076             ["favourites", "food"] => ["Mapo tofu", "Gongbao chicken"]
1077             )
1078             );
1079              
1080             is the equivalent of checking that
1081              
1082             cmp_deeply([$obj->name], ["John"]);
1083             cmp_deeply([$obj->favourites("food")], ["Mapo tofu", "Gongbao chicken"]);
1084              
1085             The methods will be called in the order you supply them.
1086              
1087             B The same caveats apply as for methods().
1088              
1089             =head3 shallow
1090              
1091             cmp_deeply( $got, shallow($thing) );
1092              
1093             C<$thing> is a ref.
1094              
1095             This prevents Test::Deep from looking inside C<$thing>. It allows you to
1096             check that C<$got_v> and C<$thing> are references to the same variable. So
1097              
1098             my @a = @b = (1, 2, 3);
1099             cmp_deeply(\@a, \@b);
1100              
1101             will pass because C<@a> and C<@b> have the same elements however
1102              
1103             cmp_deeply(\@a, shallow(\@b))
1104              
1105             will fail because although C<\@a> and C<\@b> both contain C<1, 2, 3> they are
1106             references to different arrays.
1107              
1108             =head3 noclass
1109              
1110             cmp_deeply( $got, noclass($thing) );
1111              
1112             C<$thing> is a structure to be compared against.
1113              
1114             This makes Test::Deep ignore the class of objects, so it just looks at the
1115             data they contain. Class checking will be turned off until Test::Deep is
1116             finished comparing C<$got_v> against C<$thing>. Once Test::Deep comes out of
1117             C<$thing> it will go back to its previous setting for checking class.
1118              
1119             This can be useful when you want to check that objects have been
1120             constructed correctly but you don't want to write lots of
1121             Ces. If C<@people> is an array of Person objects then
1122              
1123             cmp_deeply(\@people, [
1124             bless {name => 'John', phone => '555-5555'}, "Person",
1125             bless {name => 'Anne', phone => '444-4444'}, "Person",
1126             ]);
1127              
1128             can be replaced with
1129              
1130             cmp_deeply(\@people, noclass([
1131             {name => 'John', phone => '555-5555'},
1132             {name => 'Anne', phone => '444-4444'}
1133             ]));
1134              
1135             However, this is testing so you should also check that the objects are
1136             blessed correctly. You could use a map to bless all those hashes or you
1137             could do a second test like
1138              
1139             cmp_deeply(\@people, array_each(isa("Person"));
1140              
1141             =head3 useclass
1142              
1143             cmp_deeply( $got, useclass($thing) );
1144              
1145             This turns back on the class comparison while inside a C.
1146              
1147             cmp_deeply(
1148             $got,
1149             noclass(
1150             [
1151             useclass( $object )
1152             ]
1153             )
1154             )
1155              
1156             In this example the class of the array reference in C<$got> is ignored but
1157             the class of C<$object> is checked, as is the class of everything inside
1158             C<$object>.
1159              
1160             =head3 re
1161              
1162             cmp_deeply( $got, re($regexp, $capture_data, $flags) );
1163              
1164             C<$regexp> is either a regular expression reference produced with C
1165             or a string which will be used to construct a regular expression.
1166              
1167             C<$capture_data> is optional and is used to check the strings captured by an
1168             regex. This should can be an array ref or a Test::Deep comparator that works
1169             on array refs.
1170              
1171             C<$flags> is an optional string which controls whether the regex runs as a
1172             global match. If C<$flags> is "g" then the regex will run as C.
1173              
1174             Without C<$capture_data>, this simply compares C<$got_v> with the regular
1175             expression provided. So
1176              
1177             cmp_deeply($got, [ re("ferg") ])
1178              
1179             is the equivalent of
1180              
1181             $got->[0] =~ /ferg/
1182              
1183             With C<$capture_data>,
1184              
1185             cmp_deeply($got, [re($regex, $capture_data)])
1186              
1187             is the equivalent of
1188              
1189             my @data = $got->[0] =~ /$regex/;
1190             cmp_deeply(\@data, $capture_data);
1191              
1192             So you can do something simple like
1193              
1194             cmp_deeply($got, re(qr/(\d\d)(\w\w)/, [25, "ab" ]))
1195              
1196             to check that C<(\d\d)> was 25 and C<(\w\w)> was "ab" but you can also use
1197             Test::Deep objects to do more complex testing of the captured values
1198              
1199             cmp_deeply(
1200             "cat=2,dog=67,sheep=3,goat=2,dog=5",
1201             re(
1202             qr/(\D+)=\d+,?/,
1203             set(qw( cat sheep dog )),
1204             "g"
1205             ),
1206             );
1207              
1208             here, the regex will match the string and will capture the animal names and
1209             check that they match the specified set, in this case it will fail,
1210             complaining that "goat" is not in the set.
1211              
1212             =head3 all
1213              
1214             cmp_deeply( $got, all(@expecteds) );
1215              
1216             C<@expecteds> is an array of expected structures.
1217              
1218             This allows you to compare data against multiple expected results and make
1219             sure each of them matches.
1220              
1221             cmp_deeply($got, all(isa("Person"), methods(name => 'John')))
1222              
1223             is equivalent to
1224              
1225             $got->isa("Person")
1226             $got->name eq 'John'
1227              
1228             If either test fails then the whole thing is considered a fail. This is a
1229             short-circuit test, the testing is stopped after the first failure, although
1230             in the future it may complete all tests so that diagnostics can be output
1231             for all failures. When reporting failure, the parts are counted from 1.
1232              
1233             Thanks to the magic of overloading, you can write
1234              
1235             any( re("^wi"), all(isa("Person"), methods(name => 'John')) )
1236              
1237             as
1238              
1239             re("^wi") | isa("Person") & methods(name => 'John')
1240              
1241             Note B C<|> not double, as C<||> cannot be overloaded. This will
1242             only work when there is a special comparison involved. If you write
1243              
1244             "john" | "anne" | "robert"
1245              
1246             Perl will turn this into
1247              
1248             "{onort"
1249              
1250             which is presumably not what you wanted. This is because perl ors them
1251             together as strings before Test::Deep gets a chance to do any overload
1252             tricks.
1253              
1254             =head3 any
1255              
1256             cmp_deeply( $got, any(@expecteds) );
1257              
1258             C<@expecteds> is an array of expected structures.
1259              
1260             This can be used to compare data against multiple expected results and make
1261             sure that at least one of them matches. This is a short-circuit test so if
1262             a test passes then none of the tests after that will be attempted.
1263              
1264             You can also use overloading with C<|> similarly to all().
1265              
1266             =head3 Isa
1267              
1268             cmp_deeply( $got, Isa($class) );
1269              
1270             =head3 isa
1271              
1272             cmp_deeply( $got, isa($class) );
1273              
1274             C<$class> is a class name.
1275              
1276             This uses C to check that C<$got_v> is blessed into the
1277             class C<$class>.
1278              
1279             B C does exactly as documented here, but C is slightly
1280             different. If C is called with 1 argument it falls through to
1281             C. If C called with 2 arguments, it falls through to
1282             C. This is to prevent breakage when you import C into
1283             a package that is used as a class. Without this, anyone calling
1284             Cisa($other_class)> would get the wrong answer. This is a hack
1285             to patch over the fact that C is exported by default.
1286              
1287             =head3 obj_isa
1288              
1289             cmp_deeply( $got, obj_isa($class) );
1290              
1291             This test accepts only objects that are instances of C<$class> or a subclass.
1292             Unlike the C test, this test will never accept class names.
1293              
1294             =head3 array_each
1295              
1296             cmp_deeply( \@got, array_each($thing) );
1297              
1298             C<$thing> is a structure to be compared against.
1299              
1300             <$got_v> must be an array reference. Each element of it will be compared to
1301             C<$thing>. This is useful when you have an array of similar things, for example
1302             objects of a known type and you don't want to have to repeat the same test
1303             for each one.
1304              
1305             my $common_tests = all(
1306             isa("MyFile"),
1307             methods(
1308             handle => isa("IO::Handle")
1309             filename => re("^/home/ted/tmp"),
1310             )
1311             );
1312              
1313             cmp_deeply($got, array_each($common_tests));
1314              
1315             is similar to
1316              
1317             foreach my $got_v (@$got) {
1318             cmp_deeply($got_v, $common_tests)
1319             }
1320              
1321             Except it will not explode if C<$got> is not an array reference. It will
1322             check that each of the objects in C<@$got> is a MyFile and that each one
1323             gives the correct results for its methods.
1324              
1325             You could go further, if for example there were 3 files and you knew the
1326             size of each one you could do this
1327              
1328             cmp_deeply(
1329             $got,
1330             all(
1331             array_each($common_tests),
1332             [
1333             methods(size => 1000),
1334             methods(size => 200),
1335             methods(size => 20)
1336             ]
1337             )
1338             )
1339             cmp_deeply($got, array_each($structure));
1340              
1341             =head3 hash_each
1342              
1343             cmp_deeply( \%got, hash_each($thing) );
1344              
1345             This test behaves like C (see above) but tests that each hash
1346             value passes its tests.
1347              
1348             =head3 str
1349              
1350             cmp_deeply( $got, str($string) );
1351              
1352             $string is a string.
1353              
1354             This will stringify C<$got_v> and compare it to C<$string> using C, even
1355             if C<$got_v> is a ref. It is useful for checking the stringified value of an
1356             overloaded reference.
1357              
1358             =head3 num
1359              
1360             cmp_deeply( $got, num($number, $tolerance) );
1361              
1362             C<$number> is a number.
1363              
1364             C<$tolerance> is an optional number.
1365              
1366             This will add 0 to C<$got_v> and check if it's numerically equal to
1367             C<$number>, even if C<$got_v> is a ref. It is useful for checking the
1368             numerical value of an overloaded reference. If C<$tolerance> is supplied
1369             then this will check that C<$got_v> and C<$exp_v> are less than
1370             C<$tolerance> apart. This is useful when comparing floating point numbers as
1371             rounding errors can make it hard or impossible for C<$got_v> to be exactly
1372             equal to C<$exp_v>. When C<$tolerance> is supplied, the test passes if
1373             C.
1374              
1375             B in Perl, C<"12blah" == 12> because Perl will be smart and convert
1376             "12blah" into 12. You may not want this. There was a strict mode but that is
1377             now gone. A "looks like a number" test will replace it soon. Until then you
1378             can usually just use the string() comparison to be more strict. This will
1379             work fine for almost all situations, however it will not work when <$got_v>
1380             is an overloaded value who's string and numerical values differ.
1381              
1382             =head3 bool, true, false
1383              
1384             cmp_deeply( $got, bool($value) );
1385             cmp_deeply( $got, true );
1386             cmp_deeply( $got, false );
1387              
1388             C<$value> is anything you like but it's probably best to use 0 or 1
1389              
1390             This will check that C<$got_v> and C<$value> have the same truth value, that
1391             is they will give the same result when used in boolean context, like in an
1392             C statement.
1393              
1394             B C and C are only imported by special request.
1395              
1396             =head3 code
1397              
1398             cmp_deeply( $got, code(\&subref) );
1399              
1400             C<\&subref> is a reference to a subroutine which will be passed a single
1401             argument, it then should return a true or false and possibly a string
1402              
1403             This will pass C<$got_v> to the subroutine which returns true or false to
1404             indicate a pass or fail. Fails can be accompanied by a diagnostic string
1405             which gives an explanation of why it's a fail.
1406              
1407             sub check_name
1408             {
1409             my $name = shift;
1410             if ($boss->likes($name))
1411             {
1412             return 1;
1413             }
1414             else
1415             {
1416             return (0, "the boss doesn't like your name");
1417             }
1418             }
1419              
1420             cmp_deeply("Brian", code(\&check_name));
1421              
1422             =head2 SET COMPARISONS
1423              
1424             Set comparisons give special semantics to array comparisons:
1425              
1426             =over 4
1427              
1428             =item * The order of items in a set is irrelevant
1429              
1430             =item * The presence of duplicate items in a set is ignored.
1431              
1432             =back
1433              
1434             As such, in any set comparison, the following arrays are equal:
1435              
1436             [ 1, 2 ]
1437             [ 1, 1, 2 ]
1438             [ 1, 2, 1 ]
1439             [ 2, 1, 1 ]
1440             [ 1, 1, 2 ]
1441              
1442             All are interpreted by C semantics as if the set was only specified as:
1443              
1444             [ 1, 2 ]
1445              
1446             All C functions return an object which can have additional items added to
1447             it:
1448              
1449             my $set = set( 1, 2 );
1450             $set->add(1, 3, 1 ); # Set is now ( 1, 2, 3 )
1451              
1452             Special care must be taken when using special comparisons within sets. See
1453             L for details.
1454              
1455             =head3 set
1456              
1457             cmp_deeply( \@got, set(@elements) );
1458              
1459             This does a set comparison, that is, it compares two arrays but ignores the
1460             order of the elements and it ignores duplicate elements, but ensures that all
1461             items in C<@elements> will be in C<$got> and all items in C<$got> will be
1462             in C<@elements>.
1463              
1464             So the following tests will be passes, and will be equivalent:
1465              
1466             cmp_deeply([1, 2, 2, 3], set(3, 2, 1, 1));
1467             cmp_deeply([1, 2, 3], set(3, 2, 1));
1468              
1469             =head3 supersetof
1470              
1471             cmp_deeply( \@got, supersetof(@elements) );
1472              
1473             This function works much like L<< C|/set >>, and performs a set comparison
1474             of C<$got_v> with the elements of C<@elements>.
1475              
1476             C is however slightly relaxed, such that C<$got> may contain things
1477             not in C<@elements>, but must at least contain all C<@elements>.
1478              
1479             These two statements are equivalent, and will be passes:
1480              
1481             cmp_deeply([1,2,3,3,4,5], supersetof(2,2,3));
1482             cmp_deeply([1,2,3,4,5], supersetof(2,3));
1483              
1484             But these will be failures:
1485              
1486             cmp_deeply([1,2,3,4,5], supersetof(2,3,6)); # 6 not in superset
1487             cmp_deeply([1], supersetof(1,2)); # 2 not in superset
1488              
1489             =head3 subsetof
1490              
1491             cmp_deeply( \@got, subsetof(@elements) );
1492              
1493             This function works much like L<< C|/set >>, and performs a set comparison
1494             of C<$got_v> with the elements of C<@elements>.
1495              
1496             This is the inverse of C, which expects all unique elements found
1497             in C<$got_v> must be in C<@elements>.
1498              
1499             cmp_deeply([1,2,4,5], subsetof(2,3,3) ) # Fail: 1,4 & 5 extra
1500             cmp_deeply([2,3,3], subsetof(1,2,4,5) ) # Fail: 3 extra
1501             cmp_deeply([2,3,3], subsetof(1,2,4,5,3)) # Pass
1502              
1503             =head3 none
1504              
1505             cmp_deeply( $got, none(@elements) );
1506              
1507             @elements is an array of elements, wherein no elements in C<@elements> may
1508             be equal to C<$got_v>.
1509              
1510             =head3 noneof
1511              
1512             cmp_deeply( \@got, noneof(@elements) );
1513              
1514             @elements is an array of elements, wherein no elements in C<@elements> may be
1515             found in C<$got_v>.
1516              
1517             For example:
1518              
1519             # Got has no 1, no 2, and no 3
1520             cmp_deeply( [1], noneof( 1, 2, 3 ) ); # fail
1521             cmp_deeply( [5], noneof( 1, 2, 3 ) ); # pass
1522              
1523             =head2 BAG COMPARISONS
1524              
1525             Bag comparisons give special semantics to array comparisons, that are similar
1526             to L<< set comparisons|/SET COMPARISONS >>, but slightly different.
1527              
1528             =over 4
1529              
1530             =item * The order of items in a bag is irrelevant
1531              
1532             =item * The presence of duplicate items in a bag is B
1533              
1534             =back
1535              
1536             As such, in any bag comparison, the following arrays are equal:
1537              
1538             [ 1, 1, 2 ]
1539             [ 1, 2, 1 ]
1540             [ 2, 1, 1 ]
1541             [ 1, 1, 2 ]
1542              
1543             However, they are B equal to any of the following:
1544              
1545             [ 1, 2 ]
1546             [ 1, 2, 2 ]
1547             [ 1, 1, 1, 2 ]
1548              
1549             All C functions return an object which can have additional items added to
1550             it:
1551              
1552             my $bag = bag( 1, 2 );
1553             $bag->add(1, 3, 1 ); # Bag is now ( 1, 1, 1, 2, 3 )
1554              
1555             Special care must be taken when using special comparisons within bags. See
1556             L for details.
1557              
1558             =head3 bag
1559              
1560             cmp_deeply( \@got, bag(@elements) );
1561              
1562             This does an order-insensitive bag comparison between C<$got> and
1563             C<@elements>, ensuring that:
1564              
1565             =over 4
1566              
1567             =item each item in C<@elements> is found in C<$got>
1568              
1569             =item the number of times a C<$expected_v> is found in C<@elements> is
1570             reflected in C<$got>
1571              
1572             =item no items are found in C<$got> other than those in C<@elements>.
1573              
1574             =back
1575              
1576             As such, the following are passes, and are equivalent to each other:
1577              
1578             cmp_deeply([1, 2, 2], bag(2, 2, 1))
1579             cmp_deeply([2, 1, 2], bag(2, 2, 1))
1580             cmp_deeply([2, 2, 1], bag(2, 2, 1))
1581              
1582             But the following are failures:
1583              
1584             cmp_deeply([1, 2, 2], bag(2, 2, 1, 1)) # Not enough 1's in Got
1585             cmp_deeply([1, 2, 2, 1], bag(2, 2, 1) ) # Too many 1's in Got
1586              
1587             =head3 superbagof
1588              
1589             cmp_deeply( \@got, superbagof( @elements ) );
1590              
1591             This function works much like L<< C|/bag >>, and performs a bag comparison
1592             of C<$got_v> with the elements of C<@elements>.
1593              
1594             C is however slightly relaxed, such that C<$got> may contain things
1595             not in C<@elements>, but must at least contain all C<@elements>.
1596              
1597             So:
1598              
1599             # pass
1600             cmp_deeply( [1, 1, 2], superbagof( 1 ) );
1601              
1602             # fail: not enough 1's in superbag
1603             cmp_deeply( [1, 1, 2], superbagof( 1, 1, 1 ));
1604              
1605             =head3 subbagof
1606              
1607             cmp_deeply( \@got, subbagof(@elements) );
1608              
1609             This function works much like L<< C|/bag >>, and performs a bag comparison
1610             of C<$got_v> with the elements of C<@elements>.
1611              
1612             This is the inverse of C, and expects all elements in C<$got> to
1613             be in C<@elements>, while allowing items to exist in C<@elements> that are not
1614             in C<$got>
1615              
1616             # pass
1617             cmp_deeply( [1], subbagof( 1, 1, 2 ) );
1618              
1619             # fail: too many 1's in subbag
1620             cmp_deeply( [1, 1, 1], subbagof( 1, 1, 2 ) );
1621              
1622             =head2 HASH COMPARISONS
1623              
1624             Typically, if you're doing simple hash comparisons,
1625              
1626             cmp_deeply( \%got, \%expected )
1627              
1628             is sufficient. C will ensure C<%got> and C<%hash> have identical
1629             keys, and each key from either has the same corresponding value.
1630              
1631             =head3 superhashof
1632              
1633             cmp_deeply( \%got, superhashof(\%hash) );
1634              
1635             This will check that the hash C<%$got> is a "super-hash" of C<%hash>. That
1636             is that all the key and value pairs in C<%hash> appear in C<%$got> but
1637             C<%$got> can have extra ones also.
1638              
1639             For example
1640              
1641             cmp_deeply({a => 1, b => 2}, superhashof({a => 1}))
1642              
1643             will pass but
1644              
1645             cmp_deeply({a => 1, b => 2}, superhashof({a => 1, c => 3}))
1646              
1647             will fail.
1648              
1649             =head3 subhashof
1650              
1651             cmp_deeply( \%got, subhashof(\%hash) );
1652              
1653             This will check that the hash C<%$got> is a "sub-hash" of C<%hash>. That is
1654             that all the key and value pairs in C<%$got> also appear in C<%hash>.
1655              
1656             For example
1657              
1658             cmp_deeply({a => 1}, subhashof({a => 1, b => 2}))
1659              
1660             will pass but
1661              
1662             cmp_deeply({a => 1, c => 3}, subhashof({a => 1, b => 2}))
1663              
1664             will fail.
1665              
1666             =head1 DIAGNOSTIC FUNCTIONS
1667              
1668             =head3 deep_diag
1669              
1670             my $reason = deep_diag($stack);
1671              
1672             C<$stack> is a value returned by cmp_details. Do not call this function
1673             if cmp_details returned a true value for C<$ok>.
1674              
1675             C returns a human readable string describing how the
1676             comparison failed.
1677              
1678             =head1 ANOTHER EXAMPLE
1679              
1680             You've written a module to handle people and their film interests. Say you
1681             have a function that returns an array of people from a query, each person is
1682             a hash with 2 keys: Name and Age and the array is sorted by Name. You can do
1683              
1684             cmp_deeply(
1685             $result,
1686             [
1687             {Name => 'Anne', Age => 26},
1688             {Name => "Bill", Age => 47}
1689             {Name => 'John', Age => 25},
1690             ]
1691             );
1692              
1693             Soon after, your query function changes and all the results now have an ID
1694             field. Now your test is failing again because you left out ID from each of
1695             the hashes. The problem is that the IDs are generated by the database and
1696             you have no way of knowing what each person's ID is. With Test::Deep you can
1697             change your query to
1698              
1699             cmp_deeply(
1700             $result,
1701             [
1702             {Name => 'John', Age => 25, ID => ignore()},
1703             {Name => 'Anne', Age => 26, ID => ignore()},
1704             {Name => "Bill", Age => 47, ID => ignore()}
1705             ]
1706             );
1707              
1708             But your test still fails. Now, because you're using a database, you no
1709             longer know what order the people will appear in. You could add a sort into
1710             the database query but that could slow down your application. Instead you
1711             can get Test::Deep to ignore the order of the array by doing a bag
1712             comparison instead.
1713              
1714             cmp_deeply(
1715             $result,
1716             bag(
1717             {Name => 'John', Age => 25, ID => ignore()},
1718             {Name => 'Anne', Age => 26, ID => ignore()},
1719             {Name => "Bill", Age => 47, ID => ignore()}
1720             )
1721             );
1722              
1723             Finally person gets even more complicated and includes a new field called
1724             Movies, this is a list of movies that the person has seen recently, again
1725             these movies could also come back in any order so we need a bag inside our
1726             other bag comparison, giving us something like
1727              
1728             cmp_deeply(
1729             $result,
1730             bag(
1731             {Name => 'John', Age => 25, ID => ignore(), Movies => bag(...)},
1732             {Name => 'Anne', Age => 26, ID => ignore(), Movies => bag(...)},
1733             {Name => "Bill", Age => 47, ID => ignore(), Movies => bag(...)}
1734             )
1735             );
1736              
1737             =head1 USING TEST::DEEP WITH TEST::BUILDER
1738              
1739             Combining C and C makes it possible to use
1740             Test::Deep in your own test classes.
1741              
1742             In a L subclass, create a test method in the following
1743             form:
1744              
1745             sub behaves_ok {
1746             my $self = shift;
1747             my $expected = shift;
1748             my $test_name = shift;
1749              
1750             my $got = do_the_important_work_here();
1751              
1752             my ($ok, $stack) = cmp_details($got, $expected);
1753             unless ($Test->ok($ok, $test_name)) {
1754             my $diag = deep_diag($stack);
1755             $Test->diag($diag);
1756             }
1757             }
1758              
1759             As the subclass defines a test class, not tests themselves, make sure it
1760             uses L, not C itself.
1761              
1762             =head1 LIMITATIONS
1763              
1764             Currently any CODE, GLOB or IO refs will be compared using shallow(), which
1765             means only their memory addresses are compared.
1766              
1767             =head1 BUGS
1768              
1769             There is a bug in set and bag compare to do with competing SCs. It only
1770             occurs when you put certain special comparisons inside bag or set
1771             comparisons you don't need to worry about it. The full details are in the
1772             C docs. It will be fixed in an upcoming version.
1773              
1774             =head1 CAVEATS
1775              
1776             =head2 SPECIAL CARE WITH SPECIAL COMPARISONS IN SETS AND BAGS
1777              
1778             If you use certain special comparisons within a bag or set comparison there is
1779             a danger that a test will fail when it should have passed. It can only happen
1780             if two or more special comparisons in the bag are competing to match elements.
1781             Consider this comparison
1782              
1783             cmp_deeply(['furry', 'furball'], bag(re("^fur"), re("furb")))
1784              
1785             There are two things that could happen, hopefully C is paired with
1786             "furry" and C is paired with "furb" and everything is fine but it
1787             could happen that C is paired with "furball" and then C
1788             cannot find a match and so the test fails. Examples of other competing
1789             comparisons are C vs C and
1790             C<< methods(m1 => "v1", m2 => "v2") >> vs C<< methods(m1 => "v1") >>
1791              
1792             This problem is could be solved by using a slower and more complicated
1793             algorithm for set and bag matching. Something for the future...
1794              
1795             =head1 WHAT ARE SPECIAL COMPARISONS?
1796              
1797             A special comparison (SC) is simply an object that inherits from
1798             Test::Deep::Cmp. Whenever C<$expected_v> is an SC then instead of checking
1799             C<$got_v eq $expected_v>, we pass control over to the SC and let it do its
1800             thing.
1801              
1802             Test::Deep exports lots of SC constructors, to make it easy for you to use
1803             them in your test scripts. For example is C is just a handy way
1804             of creating a Test::Deep::Regexp object that will match any string containing
1805             "hello". So
1806              
1807             cmp_deeply([ 'a', 'b', 'hello world'], ['a', 'b', re("^hello")]);
1808              
1809             will check C<'a' eq 'a'>, C<'b' eq 'b'> but when it comes to comparing
1810             C<'hello world'> and C it will see that
1811             $expected_v is an SC and so will pass control to the Test::Deep::Regexp class
1812             by do something like C<< $expected_v->descend($got_v) >>. The C
1813             method should just return true or false.
1814              
1815             This gives you enough to write your own SCs but I haven't documented how
1816             diagnostics works because it's about to get an overhaul (theoretically).
1817              
1818             =head1 EXPORTS
1819              
1820             By default, Test::Deep will export everything in its C tag, as if you had
1821             written:
1822              
1823             use Test::Deep ':v0';
1824              
1825             Those things are:
1826              
1827             all any array array_each arrayelementsonly arraylength arraylengthonly bag
1828             blessed bool cmp_bag cmp_deeply cmp_methods cmp_set code eq_deeply hash
1829             hash_each hashkeys hashkeysonly ignore Isa isa listmethods methods noclass
1830             none noneof num obj_isa re reftype regexpmatches regexponly regexpref
1831             regexprefonly scalarrefonly scalref set shallow str subbagof subhashof
1832             subsetof superbagof superhashof supersetof useclass
1833              
1834             A slightly better set of exports is the C set. It's all the same things,
1835             with the exception of C and C. If you want to import
1836             "everything", you probably want to C<< use Test::Deep ':V1'; >>.
1837              
1838             There's another magic export group: C<:preload>. If that is specified, all of
1839             the Test::Deep plugins will be loaded immediately instead of lazily.
1840              
1841             =head1 SEE ALSO
1842              
1843             L
1844              
1845             =head1 THANKS
1846              
1847             Thanks to Michael G Schwern for Test::More's is_deeply function which inspired
1848             this library.
1849              
1850             =head1 AUTHORS
1851              
1852             =over 4
1853              
1854             =item *
1855              
1856             Fergal Daly
1857              
1858             =item *
1859              
1860             Ricardo SIGNES
1861              
1862             =back
1863              
1864             =head1 CONTRIBUTORS
1865              
1866             =for stopwords Alexander Karelas Belden Lyman Daniel Böhmer David Steinbrunner Denis Ibaev Ed Adjei Fabrice Gabolde Felipe Gasper Fergal Daly George Hartzell Graham Knop Ivan Bessarabov José Joaquín Atria Karen Etheridge Kent Fredric Lance Wicks Matthew Horsfall Michael Hamlin Mohammad S Anwar Peter Haworth Philip J. Ludlam Ricardo Signes Zoffix Znet
1867              
1868             =over 4
1869              
1870             =item *
1871              
1872             Alexander Karelas
1873              
1874             =item *
1875              
1876             Belden Lyman
1877              
1878             =item *
1879              
1880             Daniel Böhmer
1881              
1882             =item *
1883              
1884             David Steinbrunner
1885              
1886             =item *
1887              
1888             Denis Ibaev
1889              
1890             =item *
1891              
1892             Ed Adjei
1893              
1894             =item *
1895              
1896             Fabrice Gabolde
1897              
1898             =item *
1899              
1900             Felipe Gasper
1901              
1902             =item *
1903              
1904             Fergal Daly
1905              
1906             =item *
1907              
1908             George Hartzell
1909              
1910             =item *
1911              
1912             Graham Knop
1913              
1914             =item *
1915              
1916             Ivan Bessarabov
1917              
1918             =item *
1919              
1920             José Joaquín Atria
1921              
1922             =item *
1923              
1924             Karen Etheridge
1925              
1926             =item *
1927              
1928             Kent Fredric
1929              
1930             =item *
1931              
1932             Lance Wicks
1933              
1934             =item *
1935              
1936             Matthew Horsfall
1937              
1938             =item *
1939              
1940             Michael Hamlin
1941              
1942             =item *
1943              
1944             Mohammad S Anwar
1945              
1946             =item *
1947              
1948             Peter Haworth
1949              
1950             =item *
1951              
1952             Philip J. Ludlam
1953              
1954             =item *
1955              
1956             Ricardo Signes
1957              
1958             =item *
1959              
1960             Zoffix Znet
1961              
1962             =back
1963              
1964             =head1 COPYRIGHT AND LICENSE
1965              
1966             This software is copyright (c) 2003 by Fergal Daly.
1967              
1968             This is free software; you can redistribute it and/or modify it under
1969             the same terms as the Perl 5 programming language system itself.
1970              
1971             =cut
1972              
1973             __END__