File Coverage

blib/lib/Test/Deep.pm
Criterion Covered Total %
statement 188 238 78.9
branch 69 84 82.1
condition 37 53 69.8
subroutine 39 39 100.0
pod 20 27 74.0
total 353 441 80.0


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