Test-Deep-1.126/000755 000767 000024 00000000000 13032230377 013422 5ustar00rjbsstaff000000 000000 Test-Deep-1.126/Changes000644 000767 000024 00000032721 13032230313 014710 0ustar00rjbsstaff000000 000000 Revision history for Test-Deep 1.126 2016-12-27 - no changes since v1.125_001 1.125_001 2016-12-27 - if objects in the "expected" structured have an as_test_deep_cmp method, it will be called and its return (which should be a Test::Deep::Cmp object) will be used as the test for that location in the structure - internal undocumented class_base routine has been replaced with a different, clearly private routine - the LeafWrapper is also used for objects with an unknown reftype (like LVALUE or other weird ones) 1.124 2016-11-05 - avoid an uninitialized warning when array_each() compares to a non-reference (thanks, Максим Вуец!) 1.123 2016-09-09 - remove test suite reliance on "." appearing @INC (thanks, Graham Knop and Karen Etheridge!) - when an object with stringification overloading fails to match a "re" test, its stringification is included in the diagnostics 1.122 2016-09-07 - added $Test::Deep::LeafWrapper to control the behavior of simple values in the "expected" definition; by default, they are treated as shallow($x) tests, but you can now say (for example) C<< $Test::Deep::LeafWrapper = \&str >> to always treat the got value as a string, even if blessed, etc. 1.121_001 2016-07-19 - documentation improvements - avoid a few evals, localize $@ in a few places where eval is used - good bye tabs, hello spaces 1.120 2015-11-27 - no changes since 0.119_01 - this massive version bump was a mistake 0.119_01 2015-11-19 - add none() test; it's like any(), but negative - fix stringification of any() expectations 0.119 2015-09-29 - remove use of Test::NoWarnings for user-facing tests 0.118 2015-07-27 TRIAL RELEASE - overloading of & and | no longer can change All or Any objects found as arguments - an All as an argument to an All constructed is flattened out into its All-ed values; the same goes for Any 0.117 2015-06-21 - do not lose argument(s) to import (fixes https://github.com/rjbs/Test-Deep/issues/29 ) 0.116 2015-06-20 - on its own, :preload options uses default group of exports 0.115 2015-01-09 - worked around a bug in chained goto on 5.8.5 0.114 2014-12-11 - improve prereqs metadata (thanks, Karen Etheridge) - add a noneof() set test (thanks, Peter Haworth) - regexponly hasn't worked... ever. now it does - passing :preload to import loads all plugins up front - a few more tests have been documented - the many exports of Test::Deep are now documented! 0.113 2014-08-22 - fix a compile error (!!) in RegexpOnly - fix some documentation typos (thanks, ZOFFIX) - add license to META file 0.112 2013-11-30 - rebuild MANIFEST, adding two forgotten files 0.111 2013-11-30 - When printing diagnostics, differentiate the type of a blessed object from the name of the class itself (RT#78288, caused by changes to how blessed objects are treated in 0.109) (thanks, Karen Etheridge) - Typo fixes (thanks, David Steinbrunner) - Fixes to clarity and accuracy of documentation (thanks, Michael Hamlin) - Add metadata links to repo and issue tracker - Added obj_isa for testing ->isa without falling back to ref($x) - Added the *experimental* ":v1" export group to skip importing Isa, isa, and blessed 0.110 2012-06-16 Allow methods() and listmethods() to work again on class methods (RT#77804) (thanks, Ricardo Signes!) 0.109 2012-02-16 UNIVERSAL::isa and UNIVERAL::can are no longer called as functions: this was deprecated in UNIVERSAL 1.03. (RT#74760, Karen Etheridge) the code that builds the exporter configuration is cleaned up; more documentation of how it may change (for the better, without breaking stuff) should appear in the near future 0.108 2010-10-15 simple (stringwise) comparison should now be much faster (thanks, NCLEATON) 0.107 2009-10-28 New maintainer: Ricardo Signes (rjbs) On 5.10.0 and newer perl, install to the "site" directory, not the core perl directory in @INC. (Prior to 5.10.0, @INC ordering was unfortunate, and fixing the install target would make upgrading difficult.) cope with new stringification of qr{} objects in 5.13.x+ (thanks, ANDK) fix Pod escaping errors (thanks, FWIE) 0.106 Release after dev. 0.105-dev Fix for perl 5.010.1 - the code to check the version and act correctly on regexp refs treated .1 as behaving like 5.011. 0.104 Document behaviour of cmp_bag when a non ARRAY-ref argument is passed to it. Explicity test for this a die with a useful message. Document and export cmp_details and deep_diag, thanks to Tom Hukins for the patch. 0.103 Detect whether isa() is being called with 1 or 2 arguments and dispatch to the correct function. This is hacky but fixes the problem of clashing with UNIVERSAL::isa(). 0.102 Behave well when a code comparator doesn't give diagnostics. Thanks to Alex Kapranoff. 0.101 Fix an overloading problem with All and Any. Thanks to Kostas Chatzikokolakis for reporting the bug and especially for explaining how to fix it :) Added a nasty hack to smooth over a problem in Test::Tester. 0.100 Apply patch from Andreas Koenig (ANDK) to cope with Perl 5.11's new REGEXP objects. 0.099 Don't explode on perl's that don't have weakrefs. If they're not available, just don't weaken the refs. It means refs can be cached for longer than desirable but it's better than explodiing. This doesn't fix all of te problems with perl 5.005 but I'm pushing it out because the previous version number upsets CPAN.pm. 0.098 Cleaned up Test::Deep::NoTest by making it call Test::Deep's import, that way it will always be in sync for exports. Also added some POD docs. Added notest_extra.t to check that things are correctly exported and working. Add cmp_details but left it undocumented. It manages localising the stack etc. Factored eq_deeply and cmp_deeply through that. This meant adding an icky hack into deep_diag. I should clean that whole thing up. Remove $name from params of eq_deeply, in code and docs, it was unused. 0.097 Fixed doc typo for re(). Fix diagnostics for code(), it was always printing undef instead of the got value. 0.096 %WrapCache was keeping references to external data. It's now local()ised at the start of a comparison just like the other caches (why I didn't do that when I added it, I don't know). Thanks to Matthijs Bomhoff for reporting the problem. 0.095 Docs and code didn't match, useclass was actually requireclass, available as both now 0.094 Changed Set and Bag to no longer issue warnings when undefs are present. Needed to make the sort and the diagnotics undef-aware. Thanks to Colin Kuskie for pointing this out. Added tests for this. 0.093 Fixed inifinte recursion when adding comparators into bags. That whole area is unpleasant - conceptually as well as implementation-wise. Comparators no longer inherit a compare method, so we only call the specialised compare if it exists, otherwise we just do normal deep comparison. Removed a debugging print. 0.092 Got the if backwards for loading Test::Builder (again for NoTest - simples changes...). No ill effects for most people as they load it via something else any but ApacheSession for example doesn't. Now tetsing for lack of testing framework. 0.091 Forgot to export lots of stuff via NoTest 0.090 Added Test::Builder::NoTest so that eq_deeply can be use entirely without Test::Builder. 0.089 Wasn't corrrectly setting $Test::Builder::Level in cmp_bag, cmp_set and cmp_methods, this caused test error messages to include the wrong line/file. Whitespace changes. 0.088 Slight twiddle to silence warnings from the new Test::Tester thanks to SSORICHE 0.087 cmp_methods, cmp_bag and cmp_set weren't passing on the test name. Thanks to Alex Kapranoff for the patch. 0.086 Add $tolerance to Number so now you can check that 2 numbers are equal, give or take a little bit. Autogenerating most of the convenience constructor routines, deleted nearly 200 lines of boilerplate. Why didn't I think of that before? Almost every test script had the same lines at the beginning. These are now in t/std.pm, another 200 lines of code (well 50% whitespace) gone. Happy. Added use warnings to the test scripts, didn't make a difference. Added inspection of strings captured from a regex and fixed up some re() doc errors. 0.085 When a hash or array value or amethod does not exist and the expected value was a reference, the diagnostics were wrong because it headed into Reftype tests. Now Test::Deep::descend catches "Does not exist" early on. Added listmethods() 0.084 Added subhashof and superhashof, restructured various Hash modules to handle sub and super. Got rid of unexported hash_elements from Test::Deep. Fixed a problem with circular set comparisons. 0.083 The cache is more efficient, using a single layer and weak refs, also previously it could be fooled by reused addresses for objects (this is not just theoretical). Now Test::Deep::descend is responsible for pushing onto the stack as well as pulling, this means most tests don't need to think about the stack at all For the stack stuff, had to create lots of "only" modules these are tests that should never be called on their own as they make assumptions about the validity of the data, they are used as subtests inside others cleaned up lots of copy and paste Data::Dumper and confess and various other bits and pieces Test::Deep::Cmp (and it's descendants) autopush themselves onto the stack of any Test::Deep::* that uses them. Cuts even more cruft. Now everything uses the compare in Test::Deep::Cmp which just does a deep comparison. This is not perfect for All and Set but it's as good as what was happeneing before now. Wrapping unknown reftypes as shallow 0.082 Got rid of silly use lib in the tests, shouldn't have been in public Added dependency on Test::More Moved from type =>, vals => to exp =>, got => in stack entries Individual descend()s no longer pop their data from the stack, that's taken care of by Test::Deep::descend. This made things simpler in all the comparisons. Added support for sub/super se/bag comparisons, thanks to Boris Sukholitko Added scalarref.t 0.081 Got rid of struct mode for num() Large internal changes, now using a stack object rather than just an array. This handles rendering the stack. The comparisons handle rendering the got and expected values now. num() and str() numify/stringify before comparing, this makes overload of == or eq irrelevant. This also prevents problems with the diag when something stringifies differently to it's numificiation or differently each time you look. fixed diag of overloaded refs to display the ref value, not the overloaded value nicer diags for booleans 0.08 Slight doc fix Added coderef calling as a test 0.07 Fixed number.t to skip strict test when if Scalar::Util is not right Major improvement of docs. No longer reads like it was written by a drunken badger. 0.06 Overhaul of Test::Deep::descend, native types are now wrapped up in a Test::Deep:Cmp object, moves lots of logic out of descend Added ArrayLength, HashKeys, RefType, and Blessed comparisons All tests now use Test::NoWarnings Broke out descend tests into hash.t, array, regexpref.t, probably should break out more Updated version of Scalar::Util dependency, thanks to Steve Purkis 0.05 No longer using overload::StrVal() for looking behind overloads as it's broken for Regexp refs in some versions of Perl. 0.04 Documented bool and included the files!! 0.03 cmp_deeply(undef, \"") calls overload::StrVal(undef) added bool test using Scalar::Util to get reftype and blessed class 0.02 Added prereq to Makefile.PL 0.01 First release Test-Deep-1.126/lib/000755 000767 000024 00000000000 13032230377 014170 5ustar00rjbsstaff000000 000000 Test-Deep-1.126/Makefile.PL000644 000767 000024 00000004027 12602571156 015404 0ustar00rjbsstaff000000 000000 use strict; use ExtUtils::MakeMaker; # this ugliness comes from incompatibility of certain versions of # Test::Tester with certain version of Test::Builder. The problem is # that people might have an old TT lying around and are also likely to # have quite a new TB. This detects that situation and hopefully # demands an install of a newer TT. my $tt_prereq = "0.04"; if (eval { require Test::Tester; require Test::Builder; 1 } && $Test::Tester::VERSION <= 0.106 && $Test::Builder::VERSION >= 0.78) { $tt_prereq = "0.107"; } my $mm_ver = ExtUtils::MakeMaker->VERSION; WriteMakefile( AUTHOR => 'Fergal Daly ', NAME => 'Test::Deep', VERSION_FROM => './lib/Test/Deep.pm', PREREQ_PM => { 'Test::Builder' => '0', 'Scalar::Util' => '1.09', # apparently CPAN doesn't get the version of Scalar::Util 'List::Util' => '1.09', }, ( $ExtUtils::MakeMaker::VERSION < 6.63_03 ? 'BUILD_REQUIRES' : 'TEST_REQUIRES' ) => { 'Test::More' => '0.88', 'Test::Tester' => $tt_prereq, }, LICENSE => "perl", # This is a dumb mistake. Why did it get done? I'm the one who did it and I # don't know. It only affects perl 5.8, and stopping doing it now would be a # problem, because upgrades wouldn't actually upgrade. I'll just leave it # here until 5.8 is really and truly dead enough. -- rjbs, 2013-11-30 ($] < 5.010 ? (INSTALLDIRS => 'perl') : ()), ($mm_ver < 6.46 ? () : (META_MERGE => { 'meta-spec' => { version => 2 }, dynamic_config => 1, resources => { homepage => 'http://github.com/rjbs/Test-Deep/', repository => { url => 'https://github.com/rjbs/Test-Deep.git', web => 'https://github.com/rjbs/Test-Deep', type => 'git', }, bugtracker => { web => 'http://github.com/rjbs/Test-Deep/issues', }, x_MailingList => 'http://lists.perl.org/list/perl-qa.html', x_IRC => 'irc://irc.perl.org/#perl-qa', }, })), ); Test-Deep-1.126/MANIFEST000644 000767 000024 00000003436 13032230377 014561 0ustar00rjbsstaff000000 000000 Changes lib/Test/Deep.pm lib/Test/Deep/All.pm lib/Test/Deep/Any.pm lib/Test/Deep/Array.pm lib/Test/Deep/ArrayEach.pm lib/Test/Deep/ArrayElementsOnly.pm lib/Test/Deep/ArrayLength.pm lib/Test/Deep/ArrayLengthOnly.pm lib/Test/Deep/Blessed.pm lib/Test/Deep/Boolean.pm lib/Test/Deep/Cache.pm lib/Test/Deep/Cache/Simple.pm lib/Test/Deep/Class.pm lib/Test/Deep/Cmp.pm lib/Test/Deep/Code.pm lib/Test/Deep/Hash.pm lib/Test/Deep/HashEach.pm lib/Test/Deep/HashElements.pm lib/Test/Deep/HashKeys.pm lib/Test/Deep/HashKeysOnly.pm lib/Test/Deep/Ignore.pm lib/Test/Deep/Isa.pm lib/Test/Deep/ListMethods.pm lib/Test/Deep/Methods.pm lib/Test/Deep/MM.pm lib/Test/Deep/None.pm lib/Test/Deep/NoTest.pm lib/Test/Deep/Number.pm lib/Test/Deep/Obj.pm lib/Test/Deep/Ref.pm lib/Test/Deep/RefType.pm lib/Test/Deep/Regexp.pm lib/Test/Deep/RegexpMatches.pm lib/Test/Deep/RegexpOnly.pm lib/Test/Deep/RegexpRef.pm lib/Test/Deep/RegexpRefOnly.pm lib/Test/Deep/RegexpVersion.pm lib/Test/Deep/ScalarRef.pm lib/Test/Deep/ScalarRefOnly.pm lib/Test/Deep/Set.pm lib/Test/Deep/Shallow.pm lib/Test/Deep/Stack.pm lib/Test/Deep/String.pm Makefile.PL MANIFEST This list of files README t/all.t t/any.t t/array.t t/array_each.t t/arraylength.t t/bag.t t/bagrecursion.t t/blessed.t t/boolean.t t/cache.t t/circular.t t/class.t t/code.t t/deep_utils.t t/descend.t t/error.t t/hash.t t/hash_each.t t/hashkeys.t t/ignore.t t/import.t t/isa.t t/lib/Over.pm t/lib/Std.pm t/listmethods.t t/memory.t t/methods.t t/none.t t/notest.t t/notest_extra.t t/number.t t/reftype.t t/regexp.t t/regexp.t.orig t/regexpref.t t/rt78288_blessed_object.t t/scalar.t t/scalarref.t t/set.t t/shallow.t t/string.t TODO META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Test-Deep-1.126/META.json000644 000767 000024 00000003045 13032230377 015045 0ustar00rjbsstaff000000 000000 { "abstract" : "unknown", "author" : [ "Fergal Daly " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150005", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Test-Deep", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "List::Util" : "1.09", "Scalar::Util" : "1.09", "Test::Builder" : "0" } }, "test" : { "requires" : { "Test::More" : "0.88", "Test::Tester" : "0.04" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "http://github.com/rjbs/Test-Deep/issues" }, "homepage" : "http://github.com/rjbs/Test-Deep/", "repository" : { "type" : "git", "url" : "https://github.com/rjbs/Test-Deep.git", "web" : "https://github.com/rjbs/Test-Deep" }, "x_IRC" : "irc://irc.perl.org/#perl-qa", "x_MailingList" : "http://lists.perl.org/list/perl-qa.html" }, "version" : "1.126", "x_serialization_backend" : "JSON::PP version 2.27400" } Test-Deep-1.126/META.yml000644 000767 000024 00000001554 13032230377 014700 0ustar00rjbsstaff000000 000000 --- abstract: unknown author: - 'Fergal Daly ' build_requires: ExtUtils::MakeMaker: '0' Test::More: '0.88' Test::Tester: '0.04' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150005' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Test-Deep no_index: directory: - t - inc requires: List::Util: '1.09' Scalar::Util: '1.09' Test::Builder: '0' resources: IRC: irc://irc.perl.org/#perl-qa MailingList: http://lists.perl.org/list/perl-qa.html bugtracker: http://github.com/rjbs/Test-Deep/issues homepage: http://github.com/rjbs/Test-Deep/ repository: https://github.com/rjbs/Test-Deep.git version: '1.126' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Test-Deep-1.126/README000644 000767 000024 00000000310 12132270362 014272 0ustar00rjbsstaff000000 000000 This module gives you lots of flexibility when testing deep structres. Install as usual - untar it the perl Makefile.PL make make test make install See the pod for full deatils of how to use this. Test-Deep-1.126/t/000755 000767 000024 00000000000 13032230377 013665 5ustar00rjbsstaff000000 000000 Test-Deep-1.126/TODO000644 000767 000024 00000006167 12743560227 014134 0ustar00rjbsstaff000000 000000 * compare handlers: hash/array slice can * warn about noclass in a circular structure... dunno now... * add tests for Sets of various things * rename diagnostics to diag_full * add Data::Dumper features, including dumping with errors highlighted * get any to generate diags for each part and splurge all if none match * add tests for useclass * will set call methods an unknown number of times? Isn't the result cached already? * cache method calls so that multiple call won't make a difference. This will only work if they don't also look inside the object * fix the compare() system so I can use descend * protect against dieing in slices * use sets in all and any's compare method * add not() * give a way to name tests so that they can be reused * use set/bag in set/bag compare() * add a holder like Code::Perl's * add variables so { key1 => var("this"), key2 => var("this")} makes sure that $h->{key1} equals $h->{key2}. Make sure they are implemented using local for scoping (no! otherwise the above will break). Maybe setvar and cmpvar * add < > lt gt * add label() to allow labelling of sections * fix add for sets so that ignore dupes doesn't kick in too early * add deep() explicitly request deep - why? * clean up quoting * fix Test::Deep::Set::add - I'll do that with the set cleanup * worry about what happens when a temp array ref gets the address of a previous temp array ref and we check them in the cache. Do we need a class for temps? * add more tests for reftype * add glob stuff * test the compare methods * make String check definedness * make regexprefs work by using some more general overload mechanism * when failing a number due to strictness we should give different diags but diags aren't flexible enough yet * add docs for comparisons * for circular refs, we are not looking for simulations but for graph isomorphisms (or possibly a class of homomorphisms, that preserve the distinctness of containers). We need a cache that can answer "assuming a=b, are these two cache-equal?" and can keep track of dependencies. Shouldn't be too hard to make it possible but making it fast could be a problem. Would naming things help? Is this getting prological? * use Class::ISA for ISA stuff, especially under 5.6.0 * get methods to emit better diags for non existant methods, including class of object * all() doesn't need to tell you part n, what matters is the test that was going on. Also any() should diags for each failure so they can be displayed if nothing passes * get set using some standard subtests * split String into String and is_eq or streq * make an iterator comparator that can run over an array or whatever use it for Array, ArrayEach, ArrayAny * need to differentiate between UNIVERSAL::isa and ->isa * beef up the reftype checking for ScalarRef so bad $self->{val} won't break it * think about merging test_class and test_reftype into 1 * fix compare for Ignore, All and Code * glob comparison * code comparison using B::Deparse? sounds like a bad idea due to private data in closures * add eval at the outler layer to catch all nasties and report them along with the data path at which they occured Test-Deep-1.126/t/all.t000644 000767 000024 00000001721 13032230313 014611 0ustar00rjbsstaff000000 000000 use strict; use warnings; use lib 't/lib'; use Std; { check_test( sub { cmp_deeply(["wine"], all( [re(qr/^wi/)], [re(qr/ne$/)], ["wine"]) ) }, { actual_ok => 1, diag => "", }, "all eq" ); check_test( sub { cmp_deeply(["wine"], all( [re(qr/^wi/)], [re(qr/ne$/)], ["wines"]) ) }, { actual_ok => 0, diag => <[0] got : 'wine' expect : 'wines' EOM }, "all not eq" ); check_tests( sub { cmp_deeply("wine", all(re("^wi")) & re('ne$'), "pass"); cmp_deeply("wine", all(re("^wi")) & re('na$'), "fail"); }, [ {actual_ok => 1}, {actual_ok => 0} ], "all with &" ); check_tests( sub { cmp_deeply("wine", re("^wi") & re('ne$'), "pass"); cmp_deeply("wine", re("^wi") & re('na$'), "fail"); }, [ {actual_ok => 1, diag => ""}, {actual_ok => 0} ], "& without all" ); } Test-Deep-1.126/t/any.t000644 000767 000024 00000001646 13032230313 014636 0ustar00rjbsstaff000000 000000 use strict; use warnings; use lib 't/lib'; use Std; { check_test( sub { cmp_deeply("wine", any("beer", "wine")) }, { actual_ok => 1, diag => "", }, "any eq" ); check_test( sub { cmp_deeply("whisky", any("beer", "wine")) }, { actual_ok => 0, diag => < 0, diag => < 1 }, { actual_ok => 0 } ], "| without any" ); } Test-Deep-1.126/t/array.t000644 000767 000024 00000002424 13032230313 015160 0ustar00rjbsstaff000000 000000 use strict; use warnings; use lib 't/lib'; use Std; { check_test( sub { cmp_deeply(["a", "b"], ["a", "b"], "array eq"); }, { name => "array eq", actual_ok => 1, diag => "", } ); check_test( sub { cmp_deeply(["a", "b"], ["a", "c"], "array not eq"); }, { name => "array not eq", actual_ok => 0, diag => <[1] got : 'b' expect : 'c' EOM } ); check_test( sub { cmp_deeply(["a", "b"], ["a"], "array got DNE"); }, { name => "array got DNE", actual_ok => 0, diag => < "array expected DNE", actual_ok => 0, diag => < 0, diag => <[0] got : array with 1 element(s) expect : array with 2 element(s) EOM }, ], "deep bad length" ); } Test-Deep-1.126/t/array_each.t000644 000767 000024 00000001012 13032230313 016130 0ustar00rjbsstaff000000 000000 use strict; use warnings; use lib 't/lib'; use Std; { my $re = qr/^wi/; check_test( sub { cmp_deeply([qw( wine wind wibble winny window )], array_each( re($re) )) }, { actual_ok => 1, diag => "", }, "array_each eq" ); check_test( sub { cmp_deeply([qw( wibble wobble winny window )], array_each( re($re) )) }, { actual_ok => 0, diag => <[1] got : 'wobble' expect : $re EOM }, "array_each not eq" ); } Test-Deep-1.126/t/arraylength.t000644 000767 000024 00000003133 13032230313 016360 0ustar00rjbsstaff000000 000000 use strict; use warnings; use lib 't/lib'; use Std; { check_tests( sub { cmp_deeply([], arraylength(0), "0"); cmp_deeply([1..3], arraylength(3), "3"); }, [ { name => "0", actual_ok => 1, diag => "", }, { name => "3", actual_ok => 1, diag => "", } ], "len ok" ); check_tests( sub { cmp_deeply({}, arraylength(2)); }, [ { actual_ok => 0, diag => < 0, diag => < "string", actual_ok => 0, diag => < "hash", actual_ok => 0, diag => < 0, diag => <[0] got : array with 1 element(s) expect : array with 2 element(s) EOM }, ], "deep bad length" ); } Test-Deep-1.126/t/bag.t000644 000767 000024 00000011301 13032230313 014565 0ustar00rjbsstaff000000 000000 use strict; use warnings; use lib 't/lib'; use Std; { check_test( sub { cmp_deeply([], bag()); }, { actual_ok => 1, diag => "", }, "empty eq" ); check_test( sub { cmp_deeply(['a', 'b', 'b', ['c', 'd']], bag('b', 'a', ['c', 'd'], 'b')); }, { actual_ok => 1, diag => "", }, "elem eq" ); check_test( sub { cmp_deeply(['a', [], 'b', 'b'], bag()); }, { actual_ok => 0, diag => < 0, diag => < 0, diag => < 0, diag => < 1, diag => '', }, "bag of bags eq" ); check_test( sub { cmp_deeply(['a', ['a', 'b', 'b'], ['c', 'd', 'c'], ['a', 'b', 'a']], bag(bag('c', 'd', 'd'), bag('a', 'b', 'a'), bag('a', 'b', 'b'), 'a') ); }, { actual_ok => 0, diag => <add($b2, $b1); $b2->[0]->add($b1, $b2); my $v1 = ['a']; my $v2 = [['b']]; push(@$v1, $v2, $v1); push(@{$v2->[0]}, $v1, $v2); check_test( sub { cmp_deeply($v1, $b1); }, { actual_ok => 1, diag => '', }, "circular double bag eq" ); $b1->add('b', 'b'); push(@$v1, 'c', 'c'); check_test( sub { cmp_deeply($v1, $b1); }, { actual_ok => 0, diag => < 1, }, "cmp_bag eq" ); check_test( sub { cmp_bag([1, 2, 2], [1, 2, 1, 2]); }, { actual_ok => 0, }, "cmp_bag not eq" ); check_test( sub { cmp_bag([1], [1], 'name1'); }, { actual_ok => 1, name => 'name1', }, "cmp_bag returns name" ); check_test( sub { cmp_bag([1], [2], 'name2'); }, { actual_ok => 0, name => 'name2', }, "cmp_bag returns name" ); check_test( sub { cmp_deeply(['a', 'b', 'c', 'a', 'a', 'b'], superbagof('b', 'a', 'b')); }, { actual_ok => 1, diag => "", }, "superbagof yes" ); check_test( sub { cmp_deeply(['a', 'b', 'c', 'a'], superbagof('d', 'b', 'd', 'b')); }, { actual_ok => 0, diag => <<'EOM', Comparing $data as a SuperBag Missing: 'b', 'd', 'd' EOM }, "superbagof no" ); check_test( sub { cmp_deeply(['b', 'a', 'b'], subbagof('a', 'b', 'c', 'a', 'a', 'b' )); }, { actual_ok => 1, diag => "", }, "subbagof yes" ); check_test( sub { cmp_deeply(['d', 'b', 'd','b'], subbagof('a', 'b', 'c', 'a')); }, { actual_ok => 0, diag => <<'EOM', Comparing $data as a SubBag Extra: 'b', 'd', 'd' EOM }, "subbagof no" ); { check_test( sub { cmp_deeply(['a', 'a', 'b', 'c', 'b'], noneof('d', 'e', 'f')); }, { actual_ok => 1, diag => "", }, "noneof yes" ); check_test( sub { cmp_deeply(['a', 'a', 'b', 'c', 'b'], noneof('b', 'c', 'd', 'e')); }, { actual_ok => 0, diag => <<'EOM', Comparing $data as a NoneOf Extra: 'b', 'c' EOM }, "noneof no" ); } eval { my @res = run_tests( sub { cmp_bag([], {}) } ) }; like($@, qr/Argument 2 to cmp_bag is not an ARRAY ref \(HASH.*\)/, "check arg 1") } Test-Deep-1.126/t/bagrecursion.t000644 000767 000024 00000000377 13032230313 016532 0ustar00rjbsstaff000000 000000 use strict; use warnings; use lib 't/lib'; use Std; # just want to make sure this doesn't go into an infitite recursion my @methods=(methods(hello=>'world'),methods(goodbye=>'world')); my $bag_o_methods=bag(@methods); ok(1, "no inifinite recursion"); Test-Deep-1.126/t/blessed.t000644 000767 000024 00000001411 13032230313 015456 0ustar00rjbsstaff000000 000000 use strict; use warnings; use lib 't/lib'; use Std; { my $b = bless [], "class"; check_test( sub { cmp_deeply($b, blessed("class")); }, { actual_ok => 1, diag => '', }, "Same" ); check_test( sub { cmp_deeply($b, blessed("other")); }, { actual_ok => 0, diag => < 1, diag => '', }, "Same" ); check_test( sub { cmp_deeply([], blessed("class")); }, { actual_ok => 0, diag => < 1, diag => "", }) x 4 ], "ok" ); check_tests( sub { cmp_deeply(1, bool(0), "num 1"); cmp_deeply("abds", bool(0), "string"); cmp_deeply(0, bool(1), "num 0"); cmp_deeply("", bool(1), "string"); }, [ { actual_ok => 0, diag => < 0, }) x 3, ], "string not eq" ); } Test-Deep-1.126/t/cache.t000644 000767 000024 00000001344 12743560227 015127 0ustar00rjbsstaff000000 000000 use strict; use warnings; use Test::More 0.88; use if $ENV{AUTHOR_TESTING}, 'Test::Warnings'; use Test::Deep::Cache; { local $Test::Deep::Expects = 0; my $cache = Test::Deep::Cache->new; my $a = \"a"; my $b = \"b"; my $c = []; ok(! $cache->cmp($a, $b), "empty cache"); $cache->add($a, $b); ok($cache->cmp($a, $b), "added"); ok($cache->cmp($b, $a), "reverse"); $cache->local; ok($cache->cmp($a, $b), "after local"); $cache->add($b, $c); ok($cache->cmp($b, $c), "local added"); $cache->finish(0); ok(! $cache->cmp($b, $c), "gone"); $cache->local; $cache->add($b, $c); ok($cache->cmp($b, $c), "local added again"); $cache->finish(1); ok($cache->cmp($b, $c), "still there"); } done_testing; Test-Deep-1.126/t/circular.t000644 000767 000024 00000004021 13032230313 015641 0ustar00rjbsstaff000000 000000 use strict; use warnings; use lib 't/lib'; use Std; { my $a1 = gen_layers(2); my $a2 = gen_layers(2); check_test( sub { cmp_deeply($a1, $a2); }, { actual_ok => 1, diag => "", }, "2 layers" ); push(@$a1, "break"); check_test( sub { cmp_deeply($a1, $a2); }, { actual_ok => 0, diag => < 1, diag => "", }, "2 layers fixed" ); } { my $a1 = gen_layers(2); my $a2 = gen_layers(3); check_test( sub { cmp_deeply($a1, $a2); }, { actual_ok => 1, diag => "", }, "2 and 3 layers" ); push(@$a1, "break"); check_test( sub { cmp_deeply($a1, $a2); }, { actual_ok => 0, diag => < 0, diag => <[2][2] got : array with 4 element(s) expect : array with 3 element(s) EOM }, "2 and 3 layers not fixed" ); } { my $a1 = gen_interleave(); my $a2 = gen_interleave(); check_test( sub { cmp_deeply($a1, $a2); }, { actual_ok => 1, diag => "", }, "interleave" ); } sub gen_layers { my $num = shift; my $first = ['text', gen_circle()]; $num--; my $last = $first; while ($num--) { my $next = ['text', gen_circle()]; push(@$last, $next); $last = $next; } push(@$last, $first); return $first } sub gen_circle { my $a = ['circle']; push(@$a, $a); return $a } sub gen_interleave { my $a = []; my $b = []; push(@$a, $b, $a); push(@$b, $a, $b); return $a; } Test-Deep-1.126/t/class.t000644 000767 000024 00000003060 13032230313 015144 0ustar00rjbsstaff000000 000000 use strict; use warnings; use lib 't/lib'; use Std; { my $bless_a = bless {}, "A::Class"; my $bless_b = bless {}, "B::Class"; my $nobless = {}; check_test( sub { cmp_deeply([$bless_a], [noclass($bless_b)]); }, { actual_ok => 1, diag => "", }, "no class eq" ); check_test( sub { cmp_deeply([$bless_a], [noclass($nobless)]); }, { actual_ok => 1, diag => "", }, "no class eq unblessed" ); check_test( sub { cmp_deeply([$bless_a], [$bless_b]); }, { actual_ok => 0, diag => <[0]) got : 'A::Class' expect : 'B::Class' EOM }, "class not eq" ); check_test( sub { cmp_deeply([$bless_a], [$nobless]); }, { actual_ok => 0, diag => <[0]) got : 'A::Class' expect : undef EOM }, "class not eq unblessed" ); my $bless_c = bless [$bless_a], "C::Class"; check_test( sub { cmp_deeply( $bless_c, bless([noclass($nobless)], "C::Class") ); }, { actual_ok => 1, diag => "", }, "class eq on/off" ); my $bless_d = bless [$bless_c], "D::Class"; check_test( sub { cmp_deeply( $bless_d, bless([noclass(bless([useclass(bless({}, "NotA::Class"))], "NotC::Class"))], "D::Class"), ); }, { actual_ok => 0, diag => <[0]->[0]) got : 'A::Class' expect : 'NotA::Class' EOM }, "class eq on/off/on" ); } Test-Deep-1.126/t/code.t000644 000767 000024 00000001710 13032230313 014751 0ustar00rjbsstaff000000 000000 use strict; use warnings; use lib 't/lib'; use Std; sub cmp { my $str = shift; if ($str eq "fergal") { return 1; } elsif ($str eq "feargal") { return (0, "your name's not down, you're not coming in"); } else { return 0; } } { check_test( sub { cmp_deeply("fergal", code(\&cmp)); }, { actual_ok => 1, diag => '', }, "code ok" ); my ($prem, $res); ($prem, $res) = check_test( sub { cmp_deeply("feargal", code(\&cmp)); }, { actual_ok => 0, }, "code not ok" ); like($res->{diag}, "/your name's not down/", "diagnostics"); like($res->{diag}, "/feargal/", "diagnostics"); ($prem, $res) = check_test( sub { cmp_deeply("fazzer", code(\&cmp)); }, { actual_ok => 0, }, "code not ok" ); like($res->{diag}, "/it failed but it didn't say why/", "no diagnostics"); like($res->{diag}, "/fazzer/", "no diagnostics"); } Test-Deep-1.126/t/deep_utils.t000644 000767 000024 00000001055 13032230313 016176 0ustar00rjbsstaff000000 000000 use strict; use warnings; use Test::More 0.88; use if $ENV{AUTHOR_TESTING}, 'Test::Warnings'; use Test::Deep qw( cmp_deeply descend render_stack methods deep_diag ); { my $a = []; my $base = Test::Deep::_td_reftype($a); is($base, "ARRAY", "_td_reftype base ref"); } { my $a = bless [], "A::Class"; my $base = Test::Deep::_td_reftype($a); is($base, "ARRAY", "_td_reftype base obj"); } { my $a = qr/a/; my $base = Test::Deep::_td_reftype($a); is($base, ($] < 5.011 ? "Regexp" : "REGEXP"), "class_base base regexp"); } done_testing; Test-Deep-1.126/t/descend.t000644 000767 000024 00000003552 13032230313 015452 0ustar00rjbsstaff000000 000000 use strict; use warnings; use lib 't/lib'; use Std; { check_test( sub { cmp_deeply("a", "a", "scalar eq"); }, { name => "scalar eq", actual_ok => 1, diag => "", } ); check_test( sub { cmp_deeply("a", "b", "scalar not eq"); }, { name => "scalar not eq", actual_ok => 0, diag => < "def undef", actual_ok => 0, diag => < "undef def", actual_ok => 0, diag => < "undef undef", actual_ok => 1, diag => '', } ); check_test( sub { cmp_deeply("", undef); }, { actual_ok => 0, diag => < "ref ref eq", actual_ok => 1, diag => "", } ); check_test( sub { cmp_deeply(\\"a", \\"b", "ref ref not eq"); }, { name => "ref ref not eq", actual_ok => 0, diag => < 1, diag => "", }, "equal refs" ); } { my @a; check_test( sub { cmp_deeply(undef, \@a); }, { actual_ok => 0, }, "not calling StrVal on undef" ); } Test-Deep-1.126/t/error.t000644 000767 000024 00000000503 13032230313 015167 0ustar00rjbsstaff000000 000000 use strict; use warnings; use lib 't/lib'; use Std; { my ($prem, @res) = eval { run_tests( sub { cmp_deeply([shallow([])], [[]], "bad special"); } ); }; like($@, qr/^Found a special comparison in \$data->\[0\]\nYou can only use specials in the expects structure/, "bad special"); } Test-Deep-1.126/t/hash.t000644 000767 000024 00000002715 13032230313 014770 0ustar00rjbsstaff000000 000000 use strict; use warnings; use lib 't/lib'; use Std; { check_test( sub { cmp_deeply({key1 => "a", key2 => "b"}, {key1 => "a", key2 => "b"}, "hash eq"); }, { name => "hash eq", actual_ok => 1, diag => "", } ); check_test( sub { cmp_deeply({key1 => "a", key2 => "b"}, {key1 => "a", key2 => "c"}, "hash not eq"); }, { name => "hash not eq", actual_ok => 0, diag => <{"key2"} got : 'b' expect : 'c' EOM } ); check_test( sub { cmp_deeply({key1 => "a"}, {key1 => "a", key2 => "c"}, "hash got DNE"); }, { name => "hash got DNE", actual_ok => 0, diag => < "a", key2 => "c"}, {key1 => "a"}, "hash expected DNE"); }, { name => "hash expected DNE", actual_ok => 0, diag => < "a", key2 => "c"}, superhashof({key1 => "a"}), "superhash ok"); }, { name => "superhash ok", actual_ok => 1, diag => "", } ); check_test( sub { cmp_deeply({key1 => "a"}, subhashof({key1 => "a", key2 => "c"}), "subhash ok"); }, { name => "subhash ok", actual_ok => 1, diag => "", } ); } Test-Deep-1.126/t/hash_each.t000644 000767 000024 00000001103 13032230313 015736 0ustar00rjbsstaff000000 000000 use strict; use warnings; use lib 't/lib'; use Std; { my $re = qr/^wi/; check_test( sub { cmp_deeply( { a => 'wine', b => 'wind', c => 'wibble'}, hash_each( re($re) ) ) }, { actual_ok => 1, diag => "", }, "hash_each eq" ); check_test( sub { cmp_deeply( { a => 'wine', b => 'wand', c => 'wibble'}, hash_each( re($re) ) ) }, { actual_ok => 0, diag => <{"b"} got : 'wand' expect : $re EOM }, "hash_each not eq" ); } Test-Deep-1.126/t/hashkeys.t000644 000767 000024 00000002106 13032230313 015656 0ustar00rjbsstaff000000 000000 use strict; use warnings; use lib 't/lib'; use Std; { check_tests( sub { cmp_deeply({}, hashkeys(), "0"); cmp_deeply({1 => 2, 3 => 4, 5 => 6}, hashkeys(1, 3, 5), "3"); }, [ { name => "0", actual_ok => 1, diag => "", }, { name => "3", actual_ok => 1, diag => "", } ], "keys ok" ); check_tests( sub { cmp_deeply({a => 2, b => 4}, hashkeys("a", "c")); }, [ { actual_ok => 0, diag => < "string", actual_ok => 0, diag => < "array", actual_ok => 0, diag => < 1, diag => "", }, "ignore" ); } Test-Deep-1.126/t/import.t000644 000767 000024 00000000164 12541657572 015403 0ustar00rjbsstaff000000 000000 use strict; use warnings; use Test::More tests => 2; use Test::Deep 'all'; ok(defined &all); ok(! defined &any); Test-Deep-1.126/t/isa.t000644 000767 000024 00000003575 13032230313 014626 0ustar00rjbsstaff000000 000000 use strict; use warnings; use lib 't/lib'; use Std; { my $a = {}; check_test( sub { cmp_deeply($a, isa("HASH")); }, { actual_ok => 1, diag => "", }, "isa eq" ); check_test( sub { cmp_deeply($a, obj_isa("HASH")); }, { actual_ok => 0, diag => < 1, diag => "", }, "isa eq" ); check_test( sub { cmp_deeply($b, obj_isa("B")); }, { actual_ok => 1, diag => "", }, "isa eq" ); check_test( sub { cmp_deeply($b, isa("A")); }, { actual_ok => 0, diag => < 0, diag => < 1, diag => "", }, "isa eq" ); check_test( sub { cmp_deeply($b, obj_isa("A")); }, { actual_ok => 1, diag => "", }, "isa eq" ); } package A; use Test::Deep; @A::ISA = qw( Test::Deep ); { ::ok(A->isa("Test::Deep"), "U::isa says yes"); ::ok(! A->isa("Test"), "U::isa says yes"); } { package C; use base 'A'; } package main; { my $c = bless {}, "C"; check_test( sub { cmp_deeply($c, isa("A")); }, { actual_ok => 1, diag => "", }, "isa eq" ); } Test-Deep-1.126/t/lib/000755 000767 000024 00000000000 13032230377 014433 5ustar00rjbsstaff000000 000000 Test-Deep-1.126/t/listmethods.t000644 000767 000024 00000004354 13032230313 016405 0ustar00rjbsstaff000000 000000 use strict; use warnings; use lib 't/lib'; use Std; foreach my $thing (fake->new, 'fake') { check_test( sub { cmp_deeply($thing, listmethods(meth1 => ["val1"], meth2 => ['a', 'b'])); }, { actual_ok => 1, diag => "", }, "listmethods eq" ); check_test( sub { cmp_deeply($thing, listmethods(meth1 => ["val1"], meth2 => ['a', 'c'])); }, { actual_ok => 0, diag => <meth2]->[1] got : 'b' expect : 'c' EOM }, "listmethods not eq" ); check_test( sub { cmp_deeply($thing, listmethods(['plus1', 2] => ["a", "a", "a"])); }, { actual_ok => 1, diag => "", }, "listmethods arg eq" ); check_test( sub { cmp_deeply($thing, listmethods(['plus1', 2] => ["a", "b", "a"])); }, { actual_ok => 0, diag => <plus1(2)]->[1] got : 'a' expect : 'b' EOM }, "listmethods arg not eq" ); my $v3 = ['val3']; check_test( sub { cmp_deeply($thing, listmethods(meth1 => ["val1"], meth3 => $v3)); }, { actual_ok => 0, diag => <meth3] got : Does not exist expect : $v3 EOM }, "listmethods DNE" ); } { my $obj = fake->new; check_test( sub { cmp_deeply( { key => [ \"a", \["b"], \$obj ] }, { key => [ \"a", \["b"], \(listmethods(meth1 => ["val1"], meth2 => ['a', 'b'])) ] } ); }, { actual_ok => 1, diag => "", }, "complex eq" ); check_test( sub { cmp_deeply( { key => [ \"a", \["b"], \$obj ] }, { key => [ \"a", \["b"], \(listmethods(meth1 => ["val1"], meth2 => ['a', 'c'])) ] } ); }, { actual_ok => 0, diag => <{"key"}[2]}->meth2]->[1] got : 'b' expect : 'c' EOM }, "complex not eq" ); } package fake; sub new { return bless {}, __PACKAGE__; } sub meth1 { return "val1"; } sub meth2 { return ('a', 'b'); } sub plus1 { my $self = shift; my $arg = shift; return ("a") x ($arg + 1); } Test-Deep-1.126/t/memory.t000644 000767 000024 00000001220 13032230313 015343 0ustar00rjbsstaff000000 000000 use strict; use warnings; use Test::Tester; use Test::More; BEGIN { require Scalar::Util; if (grep /^weaken$/, @Scalar::Util::EXPORT_FAIL) { plan(skip_all => "no weak refs in this version of perl"); exit(0); } }use lib 't/lib'; use Std; use Scalar::Util qw( isweak weaken); sub left { my $ref = shift; eq_deeply($ref, []); return "left"; } sub right { my $ref = shift; eq_deeply([], $ref); return "right"; } my @subs = (\&left, \&right); for my $sub (@subs) { my $ref = []; my $weak = $ref; weaken($weak); my $side = &$sub($ref, []); $ref = 1; ok((! $weak), "$side didn't capture") || diag "weak = $weak"; } Test-Deep-1.126/t/methods.t000644 000767 000024 00000004672 13032230313 015514 0ustar00rjbsstaff000000 000000 use strict; use warnings; use lib 't/lib'; use Std; foreach my $thing (fake->new, 'fake') { check_test( sub { cmp_deeply($thing, methods(meth1 => "val1", meth2 => ['a', 'b'])); }, { actual_ok => 1, diag => "", }, "methods eq" ); check_test( sub { cmp_deeply($thing, methods(meth1 => "val1", meth2 => ['a', 'c'])); }, { actual_ok => 0, diag => <meth2->[1] got : 'b' expect : 'c' EOM }, "methods not eq" ); check_test( sub { cmp_deeply($thing, methods(['plus1', 2] => 3)); }, { actual_ok => 1, diag => "", }, "methods arg eq" ); check_test( sub { cmp_deeply($thing, methods(['plus1', 2] => 2)); }, { actual_ok => 0, diag => <plus1(2) got : '3' expect : '2' EOM }, "methods arg not eq" ); check_test( sub { cmp_deeply($thing, methods(meth1 => "val1", meth3 => "val3")); }, { actual_ok => 0, diag => <meth3 got : Does not exist expect : 'val3' EOM }, "methods DNE" ); } { my $obj = fake->new; check_test( sub { cmp_deeply( { key => [ \"a", \["b"], \$obj ] }, { key => [ \"a", \["b"], \(methods(meth1 => "val1", meth2 => ['a', 'b'])) ] } ); }, { actual_ok => 1, diag => "", }, "complex eq" ); check_test( sub { cmp_deeply( { key => [ \"a", \["b"], \$obj ] }, { key => [ \"a", \["b"], \(methods(meth1 => "val1", meth2 => ['a', 'c'])) ] } ); }, { actual_ok => 0, diag => <{"key"}[2]}->meth2->[1] got : 'b' expect : 'c' EOM }, "complex not eq" ); check_test( sub { cmp_methods($obj, [meth1 => "val1", meth2 => ['a', 'b']]); }, { actual_ok => 1, diag => "", }, "methods eq" ); check_test( sub { cmp_methods($obj, [meth1 => "val1", meth2 => ['a', 'c']]); }, { actual_ok => 0, }, "methods not eq" ); } package fake; sub new { return bless {}, __PACKAGE__; } sub meth1 { return "val1"; } sub meth2 { return ['a', 'b']; } sub plus1 { my $self = shift; my $arg = shift; return $arg + 1; } Test-Deep-1.126/t/none.t000644 000767 000024 00000002047 13032230313 015002 0ustar00rjbsstaff000000 000000 use strict; use warnings; use lib 't/lib'; use Std; { check_test( sub { cmp_deeply("wine", none("beer", "wine")) }, { actual_ok => 0, diag => < 1, diag => "", }, "none eq ok" ); check_test( sub { cmp_deeply("whisky", none("beer") | "wine") }, { actual_ok => 1, diag => "", }, "none with | match none" ); check_test( sub { cmp_deeply("wine", none("beer") | "wine") }, { actual_ok => 1, diag => "", }, "none with | match alternative" ); check_test( sub { cmp_deeply("beer", none("beer") | "wine") }, { actual_ok => 0, diag => < 1, diag => "", }, "number eq" ); check_test( sub { cmp_deeply(1, num(2)) }, { actual_ok => 0, diag => < 1, diag => "", }, "funny number eq" ); check_test( sub { cmp_deeply("1a", num(2)) }, { actual_ok => 0, diag => < 1, diag => "", }, "number tolerance eq" ); check_test( sub { cmp_deeply(1, num(2, .5)) }, { actual_ok => 0, diag => <new(1); check_test( sub { cmp_deeply($o, num(1)) }, { actual_ok => 1, diag => "", }, "over number eq" ); check_test( sub { cmp_deeply($o, num(2)) }, { actual_ok => 0, diag => < 1, diag => '', }, "ARRAY ok" ); check_test( sub { cmp_deeply([], reftype("HASH")); }, { actual_ok => 0, diag => < 1, diag => "", }, "re eq" ); check_test( sub { cmp_deeply("fergal", regexponly($re)); }, { actual_ok => 1, diag => "", }, "regexponly eq" ); check_test( sub { cmp_deeply("feargal", re($re)); }, { actual_ok => 0, diag => < 0, diag => < 1, diag => "", }, "string re eq" ); check_test( sub { cmp_deeply("feargal", re($str)); }, { actual_ok => 0, diag => < 1, diag => "", }, "matches re eq" ); check_test( sub { cmp_deeply("abc", re($re, [qw( a c )], "g")); }, { actual_ok => 1, diag => "", }, "matches global re eq" ); check_test( sub { cmp_deeply("abc", re($re, [qw( a b )], "g")); }, { actual_ok => 0, diag => <[1] got : 'c' expect : 'b' EOM }, "matches global not eq" ); } { my $re = qr/(..)/; check_test( sub { cmp_deeply("abababcdcdefef", re($re, set(qw( ab cd ef )), "g")); }, { actual_ok => 1, diag => "", }, "matches re and set eq" ); check_test( sub { cmp_deeply("cat=2,dog=67,sheep=3,goat=2,dog=5", re(qr/(\D+)=\d+,?/, set(qw( cat sheep dog )), "g")) }, { actual_ok => 0, diag => <new("hi mom"); is("$o", "hi mom", "we make a stringifiable object"); check_test( sub { cmp_deeply($o, re(qr/mom/)); }, { actual_ok => 1 }, "re() tests objects via overloading", ); # Remember, Regexp stringification changes over time. -- rjbs, 2016-09-08 my $re = qr/dad/; my $re_str = "$re"; check_test( sub { cmp_deeply($o, re($re)); }, { actual_ok => 0, diag => < 1, diag => "", }, "re eq" ); check_test( sub { cmp_deeply("feargal", re($re)); }, { actual_ok => 0, diag => < 1, diag => "", }, "string re eq" ); check_test( sub { cmp_deeply("feargal", re($str)); }, { actual_ok => 0, diag => < "regexp ref eq", actual_ok => 1, diag => "", } ); check_test( sub { cmp_deeply(qr/a/, qr/b/, "regexp ref not eq"); }, { name => "regexp ref not eq", actual_ok => 0, diag => < 'all'; use lib 't/lib'; use Std; check_test( sub { cmp_deeply('Foo', isa('Foo')) }, { actual_ok => 0, diag => < 0, diag => < 0, diag => < 0, diag => <[0] got : '$a' expect : $a EOM }, "shallow not eq" ); check_test( sub { cmp_deeply([$a, ["b"]], [shallow($a), ["a"]]); }, { actual_ok => 0, diag => <[1][0] got : 'b' expect : 'a' EOM }, "deep after shallow not eq" ); } Test-Deep-1.126/t/scalarref.t000644 000767 000024 00000001264 13032230313 016005 0ustar00rjbsstaff000000 000000 use strict; use warnings; use lib 't/lib'; use Std; { check_test( sub { cmp_deeply(\"a", \"a", "scalar ref eq"); }, { name => "scalar ref eq", actual_ok => 1, diag => "", } ); check_test( sub { cmp_deeply(\"a", \"b", "scalar ref not eq"); }, { name => "scalar ref not eq", actual_ok => 0, diag => < "scalar ref not ref", actual_ok => 0, diag => < 1, diag => "", }, "empty eq" ); check_test( sub { cmp_deeply(["a"], set("a", "a")); }, { actual_ok => 1, diag => "", }, "empty eq" ); check_test( sub { cmp_deeply(['a', 'b', 'b', ['c', 'd']], set('b', 'a', ['c', 'd'], 'b')); }, { actual_ok => 1, diag => "", }, "3 elem eq" ); check_test( sub { cmp_deeply(['a', [], 'b', 'b'], set()); }, { actual_ok => 0, diag => < 0, diag => < 0, diag => < 0, diag => < 1, diag => '', }, "set of sets eq" ); check_test( sub { cmp_deeply([['a', 'b', 'c'], ['c', 'd', 'c'], ['a', 'b', 'a']], set(set('c', 'd', 'c'), set('a', 'b', 'a'), set('b', 'b', 'a')) ); }, { actual_ok => 0, diag => <add($b1, $b2, $b1); $b2->[0]->add($b2, $b1, $b2); my $v1 = ['a']; my $v2 = [['b']]; push(@$v1, $v2, $v1, $v2); push(@{$v2->[0]}, $v1, $v2, $v1); check_test( sub { cmp_deeply($v1, $b1); }, { actual_ok => 1, diag => '', }, "circular double set eq" ); $b1->add('b', 'b'); push(@$v1, 'c', 'c'); check_test( sub { cmp_deeply($v1, $b1); }, { actual_ok => 0, diag => < 1, }, "cmp_set eq" ); check_test( sub { cmp_set([1, 2, 2, 3], [1, 1, 2]); }, { actual_ok => 0, }, "cmp_set not eq" ); } { my $a1 = \"a"; my $b1 = \"b"; my $a2 = \"a"; my $b2 = \"b"; TODO: { todo_skip( "Because I want to get it out the door see notes on bags and sets", 5 ); check_test( sub { cmp_deeply([[\'a', \'b']], set(set($a2, $b1), set($b2, $a1))) }, { actual_ok => 1, diag => "", }, "set compare()" ); } check_test( sub { cmp_deeply(['a', 'b', 'c', 'a'], supersetof('b', 'a', 'b')); }, { actual_ok => 1, diag => "", }, "supersetof yes" ); check_test( sub { cmp_deeply(['a', 'b', 'c', 'a'], supersetof('d', 'b', 'd')); }, { actual_ok => 0, diag => <<'EOM', Comparing $data as a SuperSet Missing: 'd' EOM }, "supersetof no" ); check_test( sub { cmp_deeply(['b', 'a', 'b'], subsetof('a', 'b', 'c', 'a')); }, { actual_ok => 1, diag => "", }, "subsetof yes" ); check_test( sub { cmp_deeply(['d', 'b', 'd'], subsetof('a', 'b', 'c', 'a')); }, { actual_ok => 0, diag => <<'EOM', Comparing $data as a SubSet Extra: 'd' EOM }, "subsetof no" ); } { check_test( sub { cmp_deeply(['a', 'b', 'c'], noneof('d', 'e', 'f')); }, { actual_ok => 1, diag => "", }, "noneof yes" ); check_test( sub { cmp_deeply(['a', 'b', 'c'], noneof('b', 'c', 'd', 'e')); }, { actual_ok => 0, diag => <<'EOM', Comparing $data as a NoneOf Extra: 'b', 'c' EOM }, "noneof no" ); } { check_test( sub { cmp_deeply([1, undef, undef], set(undef, 1, undef)); }, { actual_ok => 1, diag => "", }, "undef warnings" ); check_test( sub { cmp_deeply([1, undef], set(1)); }, { actual_ok => 0, diag => < 1, diag => "", }, "shallow eq" ); my $b = []; check_test( sub { cmp_deeply([$a, ["b"]], [shallow($b), ["b"]]); }, { actual_ok => 0, diag => <[0] got : $a expect : $b EOM }, "shallow not eq" ); check_test( sub { cmp_deeply([$a."", ["b"]], [shallow($a), ["b"]]); }, { actual_ok => 0, diag => <[0] got : '$a' expect : $a EOM }, "shallow not eq" ); check_test( sub { cmp_deeply([$a, ["b"]], [shallow($a), ["a"]]); }, { actual_ok => 0, diag => <[1][0] got : 'b' expect : 'a' EOM }, "deep after shallow not eq" ); } { my $u = shallow(undef); check_tests( sub { cmp_deeply(undef, $u); cmp_deeply("a", $u); cmp_deeply("a", $u); cmp_deeply("a", undef); }, [ { actual_ok => 1, }, { actual_ok => 0, }, { actual_ok => 0, }, { actual_ok => 0, }, ], "deep after shallow not eq" ); } { check_test( sub { cmp_deeply( Test::Deep::EqOverloaded->new, 5); }, { actual_ok => 0, }, "comparing a plain scalar leaf against obj without eq" ); local $Test::Deep::LeafWrapper = \&str; check_tests( sub { cmp_deeply( Test::Deep::EqOverloaded->new, 5); cmp_deeply( Test::Deep::EqOverloaded->new, 6); }, [ { actual_ok => 1, }, { actual_ok => 0, }, ], "comparing a plain scalar leaf against obj with eq" ); } { package Test::Deep::EqOverloaded; use overload q{""} => sub { "5" }, fallback => 1; sub new { my $self = {}; bless $self; } } Test-Deep-1.126/t/string.t000644 000767 000024 00000001476 13032230313 015356 0ustar00rjbsstaff000000 000000 use strict; use warnings; use lib 't/lib'; use Std; { check_test( sub { cmp_deeply("wine", str("wine")) }, { actual_ok => 1, diag => "", }, "string eq" ); check_test( sub { cmp_deeply("wine", str("wind")) }, { actual_ok => 0, diag => <new("wine"); check_test( sub { cmp_deeply($o, str("wine")) }, { actual_ok => 1, diag => "", }, "over string eq" ); check_test( sub { cmp_deeply($o, str("wind")) }, { actual_ok => 0, diag => < \&val, '0+' => \&val, fallback => 1; sub new { my $pkg = shift; my $val = shift; return bless \$val, $pkg; } sub val { my $self = shift; return $$self; } 1; Test-Deep-1.126/t/lib/Std.pm000644 000767 000024 00000000314 13032230313 015507 0ustar00rjbsstaff000000 000000 use strict; use warnings; use Test::Tester; use Test::More 0.88; use if $ENV{AUTHOR_TESTING}, 'Test::Warnings'; use Test::Deep; Test::Deep::builder(Test::Tester::capture()); END { done_testing; } 1; Test-Deep-1.126/lib/Test/000755 000767 000024 00000000000 13032230377 015107 5ustar00rjbsstaff000000 000000 Test-Deep-1.126/lib/Test/Deep/000755 000767 000024 00000000000 13032230377 015764 5ustar00rjbsstaff000000 000000 Test-Deep-1.126/lib/Test/Deep.pm000644 000767 000024 00000140610 13032230313 016312 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep; use Carp qw( confess ); use Test::Deep::Cache; use Test::Deep::Stack; use Test::Deep::RegexpVersion; require overload; use Scalar::Util; my $Test; unless (defined $Test::Deep::NoTest::NoTest) { # for people who want eq_deeply but not Test::Builder require Test::Builder; $Test = Test::Builder->new; } our ($Stack, %Compared, $CompareCache, %WrapCache, $Shallow); our $VERSION = '1.126'; $VERSION =~ tr/_//d; require Exporter; our @ISA = qw( Exporter ); our $Snobby = 1; # should we compare classes? our $Expects = 0; # are we comparing got vs expect or expect vs expect our $LeafWrapper; # to wrap simple values in a test; if not set, shallow() our $DNE = \""; our $DNE_ADDR = Scalar::Util::refaddr($DNE); # if no sub name is supplied then we use the package name in lower case my @constructors = ( All => "", Any => "", Array => "", ArrayEach => "array_each", ArrayElementsOnly => "", ArrayLength => "", ArrayLengthOnly => "", Blessed => "", Boolean => "bool", Code => "", Hash => "", HashEach => "hash_each", HashKeys => "", HashKeysOnly => "", Ignore => "", Isa => "Isa", ListMethods => "", Methods => "", None => "", Number => "num", Obj => "obj_isa", RefType => "", Regexp => "re", RegexpMatches => "", RegexpOnly => "", RegexpRef => "", RegexpRefOnly => "", ScalarRef => "scalref", ScalarRefOnly => "", Shallow => "", String => "str", ); my @CONSTRUCTORS_FROM_CLASSES; while (my ($pkg, $name) = splice @constructors, 0, 2) { $name = lc($pkg) unless $name; my $full_pkg = "Test::Deep::$pkg"; my $file = "$full_pkg.pm"; $file =~ s#::#/#g; my $sub = sub { require $file; return $full_pkg->new(@_); }; { no strict 'refs'; *{$name} = $sub; } push @CONSTRUCTORS_FROM_CLASSES, $name; } { our @EXPORT_OK = qw( descend render_stack cmp_details deep_diag ); our %EXPORT_TAGS; $EXPORT_TAGS{preload} = []; $EXPORT_TAGS{v0} = [ qw( Isa blessed obj_isa all any array array_each arrayelementsonly arraylength arraylengthonly bag bool cmp_bag cmp_deeply cmp_methods cmp_set code eq_deeply hash hash_each hashkeys hashkeysonly ignore isa listmethods methods noclass none noneof num re reftype regexpmatches regexponly regexpref regexprefonly scalarrefonly scalref set shallow str subbagof subhashof subsetof superbagof superhashof supersetof useclass ) ]; $EXPORT_TAGS{v1} = [ qw( obj_isa all any array array_each arrayelementsonly arraylength arraylengthonly bag bool cmp_bag cmp_deeply cmp_methods cmp_set code eq_deeply hash hash_each hashkeys hashkeysonly ignore listmethods methods noclass none noneof num re reftype regexpmatches regexponly regexpref regexprefonly scalarrefonly scalref set shallow str subbagof subhashof subsetof superbagof superhashof supersetof useclass ) ]; our @EXPORT = @{ $EXPORT_TAGS{ v0 } }; $EXPORT_TAGS{all} = [ @EXPORT, @EXPORT_OK ]; } sub import { my $self = shift; my @sans_preload = grep {; $_ ne ':preload' } @_; if (@_ != @sans_preload) { require Test::Deep::All; require Test::Deep::Any; require Test::Deep::Array; require Test::Deep::ArrayEach; require Test::Deep::ArrayElementsOnly; require Test::Deep::ArrayLength; require Test::Deep::ArrayLengthOnly; require Test::Deep::Blessed; require Test::Deep::Boolean; require Test::Deep::Cache::Simple; require Test::Deep::Cache; require Test::Deep::Class; require Test::Deep::Cmp; require Test::Deep::Code; require Test::Deep::Hash; require Test::Deep::HashEach; require Test::Deep::HashElements; require Test::Deep::HashKeys; require Test::Deep::HashKeysOnly; require Test::Deep::Ignore; require Test::Deep::Isa; require Test::Deep::ListMethods; require Test::Deep::Methods; require Test::Deep::MM; require Test::Deep::None; require Test::Deep::Number; require Test::Deep::Obj; require Test::Deep::Ref; require Test::Deep::RefType; require Test::Deep::Regexp; require Test::Deep::RegexpMatches; require Test::Deep::RegexpOnly; require Test::Deep::RegexpRef; require Test::Deep::RegexpRefOnly; require Test::Deep::RegexpVersion; require Test::Deep::ScalarRef; require Test::Deep::ScalarRefOnly; require Test::Deep::Set; require Test::Deep::Shallow; require Test::Deep::Stack; require Test::Deep::String; } $self->export_to_level(1, $self, @_); } # this is ugly, I should never have exported a sub called isa now I # have to try figure out if the recipient wanted my isa or if a class # imported us and UNIVERSAL::isa is being called on that class. # Luckily our isa always expects 1 argument and U::isa always expects # 2, so we can figure out (assuming the caller is not buggy). sub isa { if (@_ == 1) { goto &Isa; } else { goto &UNIVERSAL::isa; } } sub cmp_deeply { my ($d1, $d2, $name) = @_; my ($ok, $stack) = cmp_details($d1, $d2); if (not $Test->ok($ok, $name)) { my $diag = deep_diag($stack); $Test->diag($diag); } return $ok; } sub cmp_details { my ($d1, $d2) = @_; local $Stack = Test::Deep::Stack->new; local $CompareCache = Test::Deep::Cache->new; local %WrapCache; my $ok = descend($d1, $d2); return ($ok, $Stack); } sub eq_deeply { my ($d1, $d2) = @_; my ($ok) = cmp_details($d1, $d2); return $ok } sub eq_deeply_cache { # this is like cross between eq_deeply and descend(). It doesn't start # with a new $CompareCache but if the comparison fails it will leave # $CompareCache as if nothing happened. However, if the comparison # succeeds then $CompareCache retains all the new information # this allows Set and Bag to handle circular refs my ($d1, $d2, $name) = @_; local $Stack = Test::Deep::Stack->new; $CompareCache->local; my $ok = descend($d1, $d2); $CompareCache->finish($ok); return $ok; } sub deep_diag { my $stack = shift; # ick! incArrow and other things expect the stack has to be visible # in a well known place . TODO clean this up local $Stack = $stack; my $where = render_stack('$data', $stack); confess "No stack to diagnose" unless $stack; my $last = $stack->getLast; my $diag; my $message; my $got; my $expected; my $exp = $last->{exp}; if (Scalar::Util::blessed($exp)) { if ($exp->can("diagnostics")) { $diag = $exp->diagnostics($where, $last); $diag =~ s/\n+$/\n/; } else { if ($exp->can("diag_message")) { $message = $exp->diag_message($where); } } } if (not defined $diag) { $got = $exp->renderGot($last->{got}) unless defined $got; $expected = $exp->renderExp unless defined $expected; $message = "Compared $where" unless defined $message; $diag = <isa("Test::Deep::Cmp")) { my $where = $Stack->render('$data'); confess "Found a special comparison in $where\nYou can only use specials in the expects structure"; } if (ref $d1 and ref $d2) { # this check is only done when we're comparing 2 expecteds against each # other if ($Expects and Scalar::Util::blessed($d1) and $d1->isa("Test::Deep::Cmp")) { # check they are the same class return 0 unless Test::Deep::blessed(Scalar::Util::blessed($d2))->descend($d1); if ($d1->can("compare")) { return $d1->compare($d2); } } my $s1 = Scalar::Util::refaddr($d1); my $s2 = Scalar::Util::refaddr($d2); if ($s1 eq $s2) { return 1; } if ($CompareCache->cmp($d1, $d2)) { # we've tried comparing these already so either they turned out to # be the same or we must be in a loop and we have to assume they're # the same return 1; } else { $CompareCache->add($d1, $d2) } } $d2 = wrap($d2); $Stack->push({exp => $d2, got => $d1}); if (ref($d1) and (Scalar::Util::refaddr($d1) == $DNE_ADDR)) { # whatever it was supposed to be, it didn't exist and so it's an # automatic fail return 0; } if ($d2->descend($d1)) { # print "d1 = $d1, d2 = $d2\nok\n"; $Stack->pop; return 1; } else { # print "d1 = $d1, d2 = $d2\nnot ok\n"; return 0; } } sub wrap { my $data = shift; my $class = Scalar::Util::blessed($data); return $data if defined $class and $data->isa("Test::Deep::Cmp"); if (defined $class and $data->can('as_test_deep_cmp')) { my $cmp = $data->as_test_deep_cmp; return $cmp if $cmp->isa('Test::Deep::Cmp'); Carp::confess("object in expected structure provides as_test_deep_cmp but it did not return a Test::Deep::Cmp"); } my $reftype = _td_reftype($data); my $cmp; if($reftype eq '') { $cmp = $Test::Deep::LeafWrapper ? $Test::Deep::LeafWrapper->($data) : shallow($data); } else { my $addr = Scalar::Util::refaddr($data); return $WrapCache{$addr} if $WrapCache{$addr}; if($reftype eq 'ARRAY') { $cmp = array($data); } elsif($reftype eq 'HASH') { $cmp = hash($data); } elsif($reftype eq 'SCALAR' or $reftype eq 'REF') { $cmp = scalref($data); } elsif(($reftype eq 'Regexp') or ($reftype eq 'REGEXP')) { $cmp = regexpref($data); } else { $cmp = $Test::Deep::LeafWrapper ? $Test::Deep::LeafWrapper->($data) : shallow($data); } $WrapCache{$addr} = $cmp; } return $cmp; } sub _td_reftype { my $val = shift; my $reftype = Scalar::Util::reftype($val); return '' unless defined $reftype; return $reftype unless $Test::Deep::RegexpVersion::OldStyle; my $blessed = Scalar::Util::blessed($val); return $reftype unless defined $blessed; if ($blessed && $blessed eq "Regexp" and $reftype eq "SCALAR") { $reftype = "Regexp" } return $reftype; } sub render_stack { my ($var, $stack) = @_; return $stack->render($var); } sub cmp_methods { local $Test::Builder::Level = $Test::Builder::Level + 1; return cmp_deeply(shift, methods(@{shift()}), shift); } sub requireclass { require Test::Deep::Class; my $val = shift; return Test::Deep::Class->new(1, $val); } # docs and export say this is called useclass, doh! *useclass = \&requireclass; sub noclass { require Test::Deep::Class; my $val = shift; return Test::Deep::Class->new(0, $val); } sub set { require Test::Deep::Set; return Test::Deep::Set->new(1, "", @_); } sub supersetof { require Test::Deep::Set; return Test::Deep::Set->new(1, "sup", @_); } sub subsetof { require Test::Deep::Set; return Test::Deep::Set->new(1, "sub", @_); } sub noneof { require Test::Deep::Set; return Test::Deep::Set->new(1, "none", @_); } sub cmp_set { local $Test::Builder::Level = $Test::Builder::Level + 1; return cmp_deeply(shift, set(@{shift()}), shift); } sub bag { require Test::Deep::Set; return Test::Deep::Set->new(0, "", @_); } sub superbagof { require Test::Deep::Set; return Test::Deep::Set->new(0, "sup", @_); } sub subbagof { require Test::Deep::Set; return Test::Deep::Set->new(0, "sub", @_); } sub cmp_bag { local $Test::Builder::Level = $Test::Builder::Level + 1; my $ref = ref($_[1]) || ""; confess "Argument 2 to cmp_bag is not an ARRAY ref (".render_val($_[1]).")" unless $ref eq "ARRAY"; return cmp_deeply(shift, bag(@{shift()}), shift); } sub superhashof { require Test::Deep::Hash; my $val = shift; return Test::Deep::SuperHash->new($val); } sub subhashof { require Test::Deep::Hash; my $val = shift; return Test::Deep::SubHash->new($val); } sub builder { if (@_) { $Test = shift; } return $Test; } 1; __END__ =head1 NAME Test::Deep - Extremely flexible deep comparison =head1 SYNOPSIS use Test::More tests => $Num_Tests; use Test::Deep; cmp_deeply( $actual_horrible_nested_data_structure, $expected_horrible_nested_data_structure, "got the right horrible nested data structure" ); cmp_deeply( $object, methods(name => "John", phone => "55378008"), "object methods ok" ); cmp_deeply( \@array, [$hash1, $hash2, ignore()], "first 2 elements are as expected, ignoring 3" ); cmp_deeply( $object, noclass({value => 5}), "object looks ok, not checking it's class" ); cmp_deeply( \@result, bag('a', 'b', {key => [1, 2]}), "array has the 3 things we wanted in some order" ); =head1 DESCRIPTION If you don't know anything about automated testing in Perl then you should probably read about Test::Simple and Test::More before preceding. Test::Deep uses the Test::Builder framework. Test::Deep gives you very flexible ways to check that the result you got is the result you were expecting. At it's simplest it compares two structures by going through each level, ensuring that the values match, that arrays and hashes have the same elements and that references are blessed into the correct class. It also handles circular data structures without getting caught in an infinite loop. Where it becomes more interesting is in allowing you to do something besides simple exact comparisons. With strings, the C operator checks that 2 strings are exactly equal but sometimes that's not what you want. When you don't know exactly what the string should be but you do know some things about how it should look, C is no good and you must use pattern matching instead. Test::Deep provides pattern matching for complex data structures Test::Deep has B> of exports. See L below. =head1 EXAMPLES How Test::Deep works is much easier to understand by seeing some examples. =head2 Without Test::Deep Say you want to test a function which returns a string. You know that your string should be a 7 digit number beginning with 0, C is no good in this situation, you need a regular expression. So you could use Test::More's C function: like($string, qr/^0[0-9]{6}$/, "number looks good"); Similarly, to check that a string looks like a name, you could do: like($string, qr/^(Mr|Mrs|Miss) \w+ \w+$/, "got title, first and last name"); Now imagine your function produces a hash with some personal details in it. You want to make sure that there are 2 keys, Name and Phone and that the name looks like a name and the phone number looks like a phone number. You could do: $hash = make_person(); like($hash->{Name}, qr/^(Mr|Mrs|Miss) \w+ \w+$/, "name ok"); like($hash->{Phone}, qr/^0[0-9]{6}$/, "phone ok"); is(scalar keys %$hash, 2, "correct number of keys"); But that's not quite right, what if make_person has a serious problem and didn't even return a hash? We really need to write if (ref($hash) eq "HASH") { like($hash->{Name}, qr/^(Mr|Mrs|Miss) \w+ \w+$/, "name ok"); like($hash->{Phone}, qr/^0[0-9]{6}$/, "phone ok"); is(scalar keys %$hash, 2, "correct number of keys"); } else { fail("person not a hash"); fail("person not a hash"); fail("person not a hash"); # need 3 to keep the plan correct } Already this is getting messy, now imagine another entry in the hash, an array of children's names. This would require if (ref($hash) eq "HASH") { like($hash->{Name}, $name_pat, "name ok"); like($hash->{Phone}, '/^0d{6}$/', "phone ok"); my $cn = $hash->{ChildNames}; if (ref($cn) eq "ARRAY") { foreach my $child (@$cn) { like($child, $name_pat); } } else { fail("child names not an array") } } else { fail("person not a hash"); } This is a horrible mess and because we don't know in advance how many children's names there will be, we can't make a plan for our test anymore (actually, we could but it would make things even more complicated). Test::Deep to the rescue. =head2 With Test::Deep my $name_re = re('^(Mr|Mrs|Miss) \w+ \w+$'); cmp_deeply( $person, { Name => $name_re, Phone => re('^0d{6}$'), ChildNames => array_each($name_re) }, "person ok" ); This will do everything that the messy code above does and it will give a sensible message telling you exactly what went wrong if it finds a part of $person that doesn't match the pattern. C and C are special function imported from Test::Deep. They create a marker that tells Test::Deep that something different is happening here. Instead of just doing a simple comparison and checking are two things exactly equal, it should do something else. If a person was asked to check that 2 structures are equal, they could print them both out and compare them line by line. The markers above are similar to writing a note in red pen on one of the printouts telling the person that for this piece of the structure, they should stop doing simple line by line comparison and do something else. C means that Test::Deep should check that the current piece of data matches the regex in C<$regex>. C means that Test::Deep should expect the current piece of data to be an array and it should check that every element of that array matches C<$struct>. In this case, every element of C<< $person->{ChildNames} >> should look like a name. If say the 3rd one didn't you would get an error message something like Using Regexp on $data->{ChildNames}[3] got : 'Queen John Paul Sartre' expect : /^(Mr|Mrs|Miss) \w+ \w+$/ There are lots of other special comparisons available, see L below for the full list. =head2 Reusing structures Test::Deep is good for reusing test structures so you can do this my $name_re = re('^(Mr|Mrs|Miss) \w+ \w+$'); my $person_cmp = { Name => $name_re, Phone => re('^0d{6}$'), ChildNames => array_each($name_re) }; cmp_deeply($person1, $person_cmp, "person ok"); cmp_deeply($person2, $person_cmp, "person ok"); cmp_deeply($person3, $person_cmp, "person ok"); You can even put $person_cmp in a module and let other people use it when they are writing test scripts for modules that use your modules. To make things a little more difficult, lets change the person data structure so that instead of a list of ChildNames, it contains a list of hashes, one for each child. So in fact our person structure will contain other person structures which may contain other person structures and so on. This is easy to handle with Test::Deep because Test::Deep structures can include themselves. Simply do my $name_re = re('^(Mr|Mrs|Miss) \w+ \w+$'); my $person_cmp = { Name => $name_re, Phone => re('^0d{6}$'), # note no mention of Children here }; $person_cmp->{Children} = array_each($person_cmp); cmp_deeply($person, $person_cmp, "person ok"); This will now check that $person->{Children} is an array and that every element of that array also matches C<$person_cmp>, this includes checking that it's children also match the same pattern and so on. =head2 Circular data structures A circular data structure is one which loops back on itself, you can make one easily by doing my @b; my @a = (1, 2, 3, \@b); push(@b, \@a); now C<@a> contains a reference to be C<@b> and C<@b> contains a reference to C<@a>. This causes problems if you have a program that wants to look inside C<@a> and keep looking deeper and deeper at every level, it could get caught in an infinite loop looking into C<@a> then C<@b> then C<@a> then C<@b> and so on. Test::Deep avoids this problem so we can extend our example further by saying that a person should also list their parents. my $name_re = re('^(Mr|Mrs|Miss) \w+ \w+$'); my $person_cmp = { Name => $name_re, Phone => re('^0d{6}$'), # note no mention of Children here }; $person_cmp->{Children} = each_array($person_cmp); $person_cmp->{Parents} = each_array($person_cmp); cmp_deeply($person, $person_cmp, "person ok"); So this will check that for each child C<$child> in C<< $person->{Children} >> that the C<< $child->{Parents} >> matches C<$person_cmp> however it is smart enough not to get caught in an infinite loop where it keeps bouncing between the same Parent and Child. =head1 TERMINOLOGY C takes 3 arguments. C<$got> is the structure that you are checking, you must not include any special comparisons in this structure or you will get a fatal error. C<$expected> describes what Test::Deep will be looking for in $got. You can put special comparisons in $expected if you want to. As Test::Deep descends through the 2 structures, it compares them one piece at a time, so at any point in the process, Test::Deep is thinking about 2 things - the current value from C<$got> and the current value from C<$expected>. In the documentation, I call them C<$got_v> and C respectively. =head1 COMPARISON FUNCTIONS =head3 cmp_deeply my $ok = cmp_deeply($got, $expected, $name) C<$got> is the result to be checked. C<$expected> is the structure against which C<$got> will be check. C<$name> is the test name. This is the main comparison function, the others are just wrappers around this. C<$got> and C<$expected> are compared recursively. Each value in C<$expected> defines what's expected at the corresponding location in C<$got>. Simple scalars are compared with C. References to structures like hashes and arrays are compared recursively. Items in C<$expected>, though, can also represent complex tests that check for numbers in a given range, hashes with at least a certain set of keys, a string matching a regex, or many other things. See L for details. =head3 cmp_bag my $ok = cmp_bag(\@got, \@bag, $name) Is shorthand for cmp_deeply(\@got, bag(@bag), $name) I: Both arguments must be array refs. If they aren't an exception will be thrown. =head3 cmp_set my $ok = cmp_set(\@got, \@set, $name) Is shorthand for cmp_deeply(\@got, set(@set), $name) =head3 cmp_methods my $ok = cmp_methods(\@got, \@methods, $name) Is shorthand for cmp_deeply(\@got, methods(@methods), $name) =head3 eq_deeply my $ok = eq_deeply($got, $expected) This is the same as cmp_deeply() except it just returns true or false. It does not create diagnostics or talk to L, but if you want to use it in a non-testing environment then you should import it through L. For example use Test::Deep::NoTest; print "a equals b" unless eq_deeply($a, $b); otherwise the L framework will be loaded and testing messages will be output when your program ends. =head3 cmp_details ($ok, $stack) = cmp_details($got, $expected) This behaves much like eq_deeply, but it additionally allows you to produce diagnostics in case of failure by passing the value in C<$stack> to C. Do not make assumptions about the structure or content of C<$stack> and do not use it if C<$ok> contains a true value. See L for example uses. =head1 SPECIAL COMPARISONS PROVIDED In the documentation below, C<$got_v> is used to indicate any given value within the C<$got> structure. =head3 ignore cmp_deeply( $got, ignore() ); This makes Test::Deep skip tests on C<$got_v>. No matter what value C<$got_v> has, Test::Deep will think it's correct. This is useful if some part of the structure you are testing is very complicated and already tested elsewhere, or if it is unpredictable. cmp_deeply( $got, { name => 'John', rando m => ignore(), address => [ '5 A street', 'a town', 'a country' ], } ); is the equivalent of checking $got->{name} eq 'John'; exists $got->{random}; cmp_deeply($got->{address}, ['5 A street', 'a town', 'a country']); =head3 methods cmp_deeply( $got, methods(%hash) ); %hash is a hash of method call => expected value pairs. This lets you call methods on an object and check the result of each call. The methods will be called in the order supplied. If you want to pass arguments to the method you should wrap the method name and arguments in an array reference. cmp_deeply( $obj, methods(name => "John", ["favourite", "food"] => "taco") ); is roughly the equivalent of checking that $obj->name eq "John" $obj->favourite("food") eq "taco" The methods will be called in the order you supply them and will be called in scalar context. If you need to test methods called in list context then you should use C. B Just as in a normal test script, you need to be careful if the methods you call have side effects like changing the object or other objects in the structure. Although the order of the methods is fixed, the order of some other tests is not so if C<$expected> is { manager => methods(@manager_methods), coder => methods(@coder_methods) } there is no way to know which if manager and coder will be tested first. If the methods you are testing depend on and alter global variables or if manager and coder are the same object then you may run into problems. =head3 listmethods cmp_deeply( $got, listmethods(%hash) ); C<%hash> is a hash of pairs mapping method names to expected return values. This is almost identical to methods() except the methods are called in list context instead of scalar context. This means that the expected return values supplied must be in array references. cmp_deeply( $obj, listmethods( name => "John", ["favourites", "food"] => ["Mapo tofu", "Gongbao chicken"] ) ); is the equivalent of checking that $obj->name eq "John" cmp_deeply([$obj->favourites("food")], ["Mapo tofu", "Gongbao chicken"]); The methods will be called in the order you supply them. B The same caveats apply as for methods(). =head3 shallow cmp_deeply( $got, shallow($thing) ); $thing is a ref. This prevents Test::Deep from looking inside $thing. It allows you to check that C<$got_v> and C<$thing> are references to the same variable. So my @a = @b = (1, 2, 3); cmp_deeply(\@a, \@b); will pass because C<@a> and C<@b> have the same elements however cmp_deeply(\@a, shallow(\@b)) will fail because although C<\@a> and C<\@b> both contain C<1, 2, 3> they are references to different arrays. =head3 noclass cmp_deeply( $got, noclass($thing) ); $thing is a structure to be compared against. This makes Test::Deep ignore the class of objects, so it just looks at the data they contain. Class checking will be turned off until Test::Deep is finished comparing C<$got_v> against C<$thing>. Once Test::Deep comes out of C<$thing> it will go back to it's previous setting for checking class. This can be useful when you want to check that objects have been constructed correctly but you don't want to write lots of Ces. If C<@people> is an array of Person objects then cmp_deeply(\@people, [ bless {name => 'John', phone => '555-5555'}, "Person", bless {name => 'Anne', phone => '444-4444'}, "Person", ]); can be replaced with cmp_deeply(\@people, noclass([ {name => 'John', phone => '555-5555'}, {name => 'Anne', phone => '444-4444'} ])); However, this is testing so you should also check that the objects are blessed correctly. You could use a map to bless all those hashes or you could do a second test like cmp_deeply(\@people, array_each(isa("Person")); =head3 useclass cmp_deeply( $got, useclass($thing) ); This turns back on the class comparison while inside a C. cmp_deeply( $got, noclass( [ useclass( $object ) ] ) ) In this example the class of the array reference in C<$got> is ignored but the class of C<$object> is checked, as is the class of everything inside C<$object>. =head3 re cmp_deeply( $got, re($regexp, $capture_data, $flags) ); C<$regexp> is either a regular expression reference produced with C or a string which will be used to construct a regular expression. C<$capture_data> is optional and is used to check the strings captured by an regex. This should can be an array ref or a Test::Deep comparator that works on array refs. C<$flags> is an optional string which controls whether the regex runs as a global match. If C<$flags> is "g" then the regex will run as C. Without C<$capture_data>, this simply compares C<$got_v> with the regular expression provided. So cmp_deeply($got, [ re("ferg") ]) is the equivalent of $got->[0] =~ /ferg/ With C<$capture_data>, cmp_deeply($got, [re($regex, $capture_data)]) is the equivalent of my @data = $got->[0] =~ /$regex/; cmp_deeply(\@data, $capture_data); So you can do something simple like cmp_deeply($got, re(qr/(\d\d)(\w\w)/, [25, "ab" ])) to check that C<(\d\d)> was 25 and C<(\w\w)> was "ab" but you can also use Test::Deep objects to do more complex testing of the captured values cmp_deeply( "cat=2,dog=67,sheep=3,goat=2,dog=5", re( qr/(\D+)=\d+,?/, set(qw( cat sheep dog )), "g" ), ); here, the regex will match the string and will capture the animal names and check that they match the specified set, in this case it will fail, complaining that "goat" is not in the set. =head3 all cmp_deeply( $got, all(@expecteds) ); C<@expecteds> is an array of expected structures. This allows you to compare data against multiple expected results and make sure each of them matches. cmp_deeply($got, all(isa("Person"), methods(name => 'John'))) is equivalent to $got->isa("Person") $got->name eq 'John' If either test fails then the whole thing is considered a fail. This is a short-circuit test, the testing is stopped after the first failure, although in the future it may complete all tests so that diagnostics can be output for all failures. When reporting failure, the parts are counted from 1. Thanks to the magic of overloading, you can write any( re("^wi"), all(isa("Person"), methods(name => 'John')) ) as re("^wi") | isa("Person") & methods(name => 'John') Note B C<|> not double, as C<||> cannot be overloaded. This will only work when there is a special comparison involved. If you write "john" | "anne" | "robert" Perl will turn this into "{onort" which is presumably not what you wanted. This is because perl ors them together as strings before Test::Deep gets a chance to do any overload tricks. =head3 any cmp_deeply( $got, any(@expecteds) ); C<@expecteds> is an array of expected structures. This can be used to compare data against multiple expected results and make sure that at least one of them matches. This is a short-circuit test so if a test passes then none of the tests after that will be attempted. You can also use overloading with C<|> similarly to all(). =head3 Isa cmp_deeply( $got, Isa($class) ); =head3 isa cmp_deeply( $got, isa($class) ); C<$class> is a class name. This uses C to check that C<$got_v> is blessed into the class C<$class>. B C does exactly as documented here, but C is slightly different. If C is called with 1 argument it falls through to C. If C called with 2 arguments, it falls through to C. This is to prevent breakage when you import C into a package that is used as a class. Without this, anyone calling Cisa($other_class)> would get the wrong answer. This is a hack to patch over the fact that C is exported by default. =head3 obj_isa cmp_deeply( $got, obj_isa($class) ); This test accepts only objects that are instances of C<$class> or a subclass. Unlike the C test, this test will never accept class names. =head3 array_each cmp_deeply( \@got, array_each($thing) ); C<$thing> is a structure to be compared against. <$got_v> must be an array reference. Each element of it will be compared to $thing. This is useful when you have an array of similar things, for example objects of a known type and you don't want to have to repeat the same test for each one. my $common_tests = all( isa("MyFile"), methods( handle => isa("IO::Handle") filename => re("^/home/ted/tmp"), ) ); cmp_deeply($got, array_each($common_tests)); is similar to foreach my $got_v (@$got) { cmp_deeply($got_v, $common_tests) } Except it will not explode if C<$got> is not an array reference. It will check that each of the objects in C<@$got> is a MyFile and that each one gives the correct results for it's methods. You could go further, if for example there were 3 files and you knew the size of each one you could do this cmp_deeply( $got, all( array_each($common_tests), [ methods(size => 1000), methods(size => 200), methods(size => 20) ] ) ) cmp_deeply($got, array_each($structure)); =head3 hash_each cmp_deeply( \%got, hash_each($thing) ); This test behaves like C (see above) but tests that each hash value passes its tests. =head3 str cmp_deeply( $got, str($string) ); $string is a string. This will stringify C<$got_v> and compare it to C<$string> using C, even if C<$got_v> is a ref. It is useful for checking the stringified value of an overloaded reference. =head3 num cmp_deeply( $got, num($number, $tolerance) ); C<$number> is a number. C<$tolerance> is an optional number. This will add 0 to C<$got_v> and check if it's numerically equal to C<$number>, even if C<$got_v> is a ref. It is useful for checking the numerical value of an overloaded reference. If C<$tolerance> is supplied then this will check that C<$got_v> and C<$exp_v> are less than C<$tolerance> apart. This is useful when comparing floating point numbers as rounding errors can make it hard or impossible for C<$got_v> to be exactly equal to C<$exp_v>. When C<$tolerance> is supplied, the test passes if C. B in Perl, C<"12blah" == 12> because Perl will be smart and convert "12blah" into 12. You may not want this. There was a strict mode but that is now gone. A "looks like a number" test will replace it soon. Until then you can usually just use the string() comparison to be more strict. This will work fine for almost all situations, however it will not work when <$got_v> is an overloaded value who's string and numerical values differ. =head3 bool cmp_deeply( $got, bool($value) ); C<$value> is anything you like but it's probably best to use 0 or 1 This will check that C<$got_v> and C<$value> have the same truth value, that is they will give the same result when used in boolean context, like in an C statement. =head3 code cmp_deeply( $got, code(\&subref) ); C<\&subref> is a reference to a subroutine which will be passed a single argument, it then should return a true or false and possibly a string This will pass C<$got_v> to the subroutine which returns true or false to indicate a pass or fail. Fails can be accompanied by a diagnostic string which gives an explanation of why it's a fail. sub check_name { my $name = shift; if ($boss->likes($name)) { return 1; } else { return (0, "the boss doesn't like your name"); } } cmp_deeply("Brian", code(\&check_name)); =head2 SET COMPARISONS Set comparisons give special semantics to array comparisons: =over 4 =item * The order of items in a set is irrelevant =item * The presence of duplicate items in a set is ignored. =back As such, in any set comparison, the following arrays are equal: [ 1, 2 ] [ 1, 1, 2 ] [ 1, 2, 1 ] [ 2, 1, 1 ] [ 1, 1, 2 ] All are interpreted by C semantics as if the set was only specified as: [ 1, 2 ] All C functions return an object which can have additional items added to it: my $set = set( 1, 2 ); $set->add(1, 3, 1 ); # Set is now ( 1, 2, 3 ) Special care must be taken when using special comparisons within sets. See L for details. =head3 set cmp_deeply( \@got, set(@elements) ); This does a set comparison, that is, it compares two arrays but ignores the order of the elements and it ignores duplicate elements, but ensures that all items in in C<@elements> will be in C<$got> and all items in C<$got> will be in C<@elements>. So the following tests will be passes, and will be equivalent: cmp_deeply([1, 2, 2, 3], set(3, 2, 1, 1)); cmp_deeply([1, 2, 3], set(3, 2, 1)); =head3 supersetof cmp_deeply( \@got, supersetof(@elements) ); This function works much like L<< C|/set >>, and performs a set comparison of C<$got_v> with the elements of C<@elements>. C is however slightly relaxed, such that C<$got> may contain things not in C<@elements>, but must at least contain all C<@elements>. These two statements are equivalent, and will be passes: cmp_deeply([1,2,3,3,4,5], supersetof(2,2,3)); cmp_deeply([1,2,3,4,5], supersetof(2,3)); But these will be failures: cmp_deeply([1,2,3,4,5], supersetof(2,3,6)); # 6 not in superset cmp_deeply([1], supersetof(1,2)); # 2 not in superset =head3 subsetof cmp_deeply( \@got, subsetof(@elements) ); This function works much like L<< C|/set >>, and performs a set comparison of C<$got_v> with the elements of C<@elements>. This is the inverse of C, which expects all unique elements found in C<$got_v> must be in C<@elements>. cmp_deeply([1,2,4,5], subsetof(2,3,3) ) # Fail: 1,4 & 5 extra cmp_deeply([2,3,3], subsetof(1,2,4,5) ) # Fail: 3 extra cmp_deeply([2,3,3], subsetof(1,2,4,5,3)) # Pass =head3 noneof cmp_deeply( \@got, noneof(@elements) ); @elements is an array of elements, wherein no elements in C<@elements> may be found in C<$got_v>. For example: # Got has no 1, no 2, and no 3 cmp_deeply( [1], noneof( 1, 2, 3 ) ); # fail cmp_deeply( [5], noneof( 1, 2, 3 ) ); # pass =head2 BAG COMPARISONS Bag comparisons give special semantics to array comparisons, that are similar to L<< set comparisons|/SET COMPARISONS >>, but slightly different. =over 4 =item * The order of items in a bag is irrelevant =item * The presence of duplicate items in a bag is B =back As such, in any bag comparison, the following arrays are equal: [ 1, 1, 2 ] [ 1, 2, 1 ] [ 2, 1, 1 ] [ 1, 1, 2 ] However, they are B equal to any of the following: [ 1, 2 ] [ 1, 2, 2 ] [ 1, 1, 1, 2 ] All C functions return an object which can have additional items added to it: my $bag = bag( 1, 2 ); $bag->add(1, 3, 1 ); # Bag is now ( 1, 1, 1, 2, 3 ) Special care must be taken when using special comparisons within bags. See L for details. =head3 bag cmp_deeply( \@got, bag(@elements) ); This does an order-insensitive bag comparison between C<$got> and C<@elements>, ensuring that: =over 4 =item each item in C<@elements> is found in C<$got> =item the number of times a C<$expected_v> is found in C<@elements> is reflected in C<$got> =item no items are found in C<$got> other than those in C<@elements>. =back As such, the following are passes, and are equivalent to each other: cmp_deeply([1, 2, 2], bag(2, 2, 1)) cmp_deeply([2, 1, 2], bag(2, 2, 1)) cmp_deeply([2, 2, 1], bag(2, 2, 1)) But the following are failures: cmp_deeply([1, 2, 2], bag(2, 2, 1, 1)) # Not enough 1's in Got cmp_deeply([1, 2, 2, 1], bag(2, 2, 1) ) # Too many 1's in Got =head3 superbagof cmp_deeply( \@got, superbagof( @elements ) ); This function works much like L<< C|/bag >>, and performs a bag comparison of C<$got_v> with the elements of C<@elements>. C is however slightly relaxed, such that C<$got> may contain things not in C<@elements>, but must at least contain all C<@elements>. So: # pass cmp_deeply( [1, 1, 2], superbagof( 1 ) ); # fail: not enough 1's in superbag cmp_deeply( [1, 1, 2], superbagof( 1, 1, 1 )); =head3 subbagof cmp_deeply( \@got, subbagof(@elements) ); This function works much like L<< C|/bag >>, and performs a bag comparison of C<$got_v> with the elements of C<@elements>. This is the inverse of C, and expects all elements in C<$got> to be in C<@elements>, while allowing items to exist in C<@elements> that are not in C<$got> # pass cmp_deeply( [1], subbagof( 1, 1, 2 ) ); # fail: too many 1's in subbag cmp_deeply( [1, 1, 1], subbagof( 1, 1, 2 ) ); =head2 HASH COMPARISONS Typically, if you're doing simple hash comparisons, cmp_deeply( \%got, \%expected ) is sufficient. C will ensure C<%got> and C<%hash> have identical keys, and each key from either has the same corresponding value. =head3 superhashof cmp_deeply( \%got, superhashof(\%hash) ); This will check that the hash C<%$got> is a "super-hash" of C<%hash>. That is that all the key and value pairs in C<%hash> appear in C<%$got> but C<%$got> can have extra ones also. For example cmp_deeply({a => 1, b => 2}, superhashof({a => 1})) will pass but cmp_deeply({a => 1, b => 2}, superhashof({a => 1, c => 3})) will fail. =head3 subhashof cmp_deeply( \%got, subhashof(\%hash) ); This will check that the hash C<%$got> is a "sub-hash" of C<%hash>. That is that all the key and value pairs in C<%$got> also appear in C<%hash>. For example cmp_deeply({a => 1}, subhashof({a => 1, b => 2})) will pass but cmp_deeply({a => 1, c => 3}, subhashof({a => 1, b => 2})) will fail. =head1 DIAGNOSTIC FUNCTIONS =head3 deep_diag my $reason = deep_diag($stack); C<$stack> is a value returned by cmp_details. Do not call this function if cmp_details returned a true value for C<$ok>. C returns a human readable string describing how the comparison failed. =head1 ANOTHER EXAMPLE You've written a module to handle people and their film interests. Say you have a function that returns an array of people from a query, each person is a hash with 2 keys: Name and Age and the array is sorted by Name. You can do cmp_deeply( $result, [ {Name => 'Anne', Age => 26}, {Name => "Bill", Age => 47} {Name => 'John', Age => 25}, ] ); Soon after, your query function changes and all the results now have an ID field. Now your test is failing again because you left out ID from each of the hashes. The problem is that the IDs are generated by the database and you have no way of knowing what each person's ID is. With Test::Deep you can change your query to cmp_deeply( $result, [ {Name => 'John', Age => 25, ID => ignore()}, {Name => 'Anne', Age => 26, ID => ignore()}, {Name => "Bill", Age => 47, ID => ignore()} ] ); But your test still fails. Now, because you're using a database, you no longer know what order the people will appear in. You could add a sort into the database query but that could slow down your application. Instead you can get Test::Deep to ignore the order of the array by doing a bag comparison instead. cmp_deeply( $result, bag( {Name => 'John', Age => 25, ID => ignore()}, {Name => 'Anne', Age => 26, ID => ignore()}, {Name => "Bill", Age => 47, ID => ignore()} ) ); Finally person gets even more complicated and includes a new field called Movies, this is a list of movies that the person has seen recently, again these movies could also come back in any order so we need a bag inside our other bag comparison, giving us something like cmp_deeply( $result, bag( {Name => 'John', Age => 25, ID => ignore(), Movies => bag(...)}, {Name => 'Anne', Age => 26, ID => ignore(), Movies => bag(...)}, {Name => "Bill", Age => 47, ID => ignore(), Movies => bag(...)} ) ); =head1 USING TEST::DEEP WITH TEST::BUILDER Combining C and C makes it possible to use Test::Deep in your own test classes. In a L subclass, create a test method in the following form: sub behaves_ok { my $self = shift; my $expected = shift; my $test_name = shift; my $got = do_the_important_work_here(); my ($ok, $stack) = cmp_details($got, $expected); unless ($Test->ok($ok, $test_name)) { my $diag = deep_diag($stack); $Test->diag($diag); } } As the subclass defines a test class, not tests themselves, make sure it uses L, not C itself. =head1 LIMITATIONS Currently any CODE, GLOB or IO refs will be compared using shallow(), which means only their memory addresses are compared. =head1 BUGS There is a bug in set and bag compare to do with competing SCs. It only occurs when you put certain special comparisons inside bag or set comparisons you don't need to worry about it. The full details are in the C docs. It will be fixed in an upcoming version. =head1 CAVEATS =head2 SPECIAL CARE WITH SPECIAL COMPARISONS IN SETS AND BAGS If you use certain special comparisons within a bag or set comparison there is a danger that a test will fail when it should have passed. It can only happen if two or more special comparisons in the bag are competing to match elements. Consider this comparison cmp_deeply(['furry', 'furball'], bag(re("^fur"), re("furb"))) There are two things that could happen, hopefully C is paired with "furry" and C is paired with "furb" and everything is fine but it could happen that C is paired with "furball" and then C cannot find a match and so the test fails. Examples of other competing comparisons are C vs C and C<< methods(m1 => "v1", m2 => "v2") >> vs C<< methods(m1 => "v1") >> This problem is could be solved by using a slower and more complicated algorithm for set and bag matching. Something for the future... =head1 WHAT ARE SPECIAL COMPARISONS? A special comparison (SC) is simply an object that inherits from Test::Deep::Cmp. Whenever C<$expected_v> is an SC then instead of checking C<$got_v eq $expected_v>, we pass control over to the SC and let it do it's thing. Test::Deep exports lots of SC constructors, to make it easy for you to use them in your test scripts. For example is C is just a handy way of creating a Test::Deep::Regexp object that will match any string containing "hello". So cmp_deeply([ 'a', 'b', 'hello world'], ['a', 'b', re("^hello")]); will check C<'a' eq 'a'>, C<'b' eq 'b'> but when it comes to comparing C<'hello world'> and C it will see that $expected_v is an SC and so will pass control to the Test::Deep::Regexp class by do something like C<< $expected_v->descend($got_v) >>. The C method should just return true or false. This gives you enough to write your own SCs but I haven't documented how diagnostics works because it's about to get an overhaul. =head1 EXPORTS By default, Test::Deep will export everything in its C tag, as if you had written: use Test::Deep ':v0'; Those things are: all any array array_each arrayelementsonly arraylength arraylengthonly bag blessed bool cmp_bag cmp_deeply cmp_methods cmp_set code eq_deeply hash hash_each hashkeys hashkeysonly ignore Isa isa listmethods methods noclass none noneof num obj_isa re reftype regexpmatches regexponly regexpref regexprefonly scalarrefonly scalref set shallow str subbagof subhashof subsetof superbagof superhashof supersetof useclass A slightly better set of exports is the C set. It's all the same things, with the exception of C and C. If you want to import "everything", you probably want to C<< use Test::Deep ':V1'; >>. There's another magic export group: C<:preload>. If that is specified, all of the Test::Deep plugins will be loaded immediately instead of lazily. =head1 SEE ALSO L =head1 MAINTAINER Ricardo Signes =head1 AUTHOR Fergal Daly Efergal@esatclear.ieE, with thanks to Michael G Schwern for Test::More's is_deeply function which inspired this. B do not bother Fergal Daly with bug reports. Send them to the maintainer (above) or submit them at L. =head1 COPYRIGHT Copyright 2003, 2004 by Fergal Daly Efergal@esatclear.ieE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F =cut Test-Deep-1.126/lib/Test/Deep/All.pm000644 000767 000024 00000001320 13032230313 017014 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::All; use Scalar::Util (); use Test::Deep::Cmp; sub init { my $self = shift; my @list = map { (Scalar::Util::blessed($_) && $_->isa('Test::Deep::All')) ? @{ $_->{val} } : Test::Deep::wrap($_) } @_; $self->{val} = \@list; } sub descend { my $self = shift; my $got = shift; my $data = $self->data; my $index = 1; foreach my $cmp (@{$self->{val}}) { $data->{index} = $index; $index++; next if Test::Deep::descend($got, $cmp); return 0 } return 1; } sub render_stack { my $self = shift; my $var = shift; my $data = shift; my $max = @{$self->{val}}; return "(Part $data->{index} of $max in $var)"; } 1; Test-Deep-1.126/lib/Test/Deep/Any.pm000644 000767 000024 00000001574 13032230313 017046 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::Any; use Scalar::Util (); use Test::Deep::Cmp; sub init { my $self = shift; my @list = map { (Scalar::Util::blessed($_) && $_->isa('Test::Deep::Any')) ? @{ $_->{val} } : Test::Deep::wrap($_) } @_; $self->{val} = \@list; } sub descend { my $self = shift; my $got = shift; foreach my $cmp (@{$self->{val}}) { return 1 if Test::Deep::eq_deeply_cache($got, $cmp); } return 0; } sub renderExp { my $self = shift; my $expect = $self->{val}; my $things = join(", ", map {$_->renderExp} @$expect); return "Any of ( $things )"; } sub diagnostics { my $self = shift; my ($where, $last) = @_; my $got = $self->renderGot($last->{got}); my $exp = $self->renderExp; my $diag = <{val} = $val; } sub descend { my $self = shift; my $got = shift; my $exp = $self->{val}; return 0 unless Test::Deep::descend($got, Test::Deep::arraylength(scalar @$exp)); return 0 unless $self->test_class($got); return Test::Deep::descend($got, Test::Deep::arrayelementsonly($exp)); } sub reset_arrow { return 0; } 1; Test-Deep-1.126/lib/Test/Deep/ArrayEach.pm000644 000767 000024 00000001005 13032230313 020143 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::ArrayEach; use Test::Deep::Cmp; use Scalar::Util (); sub init { my $self = shift; my $val = shift; $self->{val} = $val; } sub descend { my $self = shift; my $got = shift; return unless ref $got && Scalar::Util::reftype($got) eq 'ARRAY'; my $exp = [ ($self->{val}) x @$got ]; return Test::Deep::descend($got, $exp); } sub renderExp { my $self = shift; my $exp = shift; return '[ ' . $self->SUPER::renderExp($self->{val}) . ', ... ]'; } 1; Test-Deep-1.126/lib/Test/Deep/ArrayElementsOnly.pm000644 000767 000024 00000001245 12743560227 021751 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::ArrayElementsOnly; use Test::Deep::Ref; sub init { my $self = shift; my $val = shift; $self->{val} = $val; } sub descend { my $self = shift; my $got = shift; my $exp = $self->{val}; my $data = $self->data; for my $i (0..$#{$exp}) { $data->{index} = $i; my $got_elem = $got->[$i]; my $exp_elem = $exp->[$i]; return 0 unless Test::Deep::descend($got_elem, $exp_elem) } return 1; } sub render_stack { my $self = shift; my ($var, $data) = @_; $var .= "->" unless $Test::Deep::Stack->incArrow; $var .= "[$data->{index}]"; return $var; } sub reset_arrow { return 0; } 1; Test-Deep-1.126/lib/Test/Deep/ArrayLength.pm000644 000767 000024 00000000566 12743560227 020561 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::ArrayLength; use Test::Deep::Ref; sub init { my $self = shift; my $val = shift; $self->{val} = $val; } sub descend { my $self = shift; my $got = shift; my $exp = $self->{val}; return 0 unless $self->test_reftype($got, "ARRAY"); return Test::Deep::descend($got, Test::Deep::arraylengthonly($exp)); } 1; Test-Deep-1.126/lib/Test/Deep/ArrayLengthOnly.pm000644 000767 000024 00000001216 12743560227 021414 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::ArrayLengthOnly; use Test::Deep::Ref; sub init { my $self = shift; my $val = shift; $self->{val} = $val; } sub descend { my $self = shift; my $got = shift; my $len = $self->{val}; return @$got == $len; } sub render_stack { my $self = shift; my ($var, $data) = @_; return "array length of $var"; } sub renderVal { my $self = shift; my $val = shift; return "array with $val element(s)" } sub renderGot { my $self = shift; my $got = shift; return $self->renderVal(@$got + 0); } sub renderExp { my $self = shift; return $self->renderVal($self->{val}); } 1; Test-Deep-1.126/lib/Test/Deep/Blessed.pm000644 000767 000024 00000001064 12743560227 017714 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::Blessed; use Test::Deep::Cmp; use Scalar::Util qw( blessed ); sub init { my $self = shift; my $val = shift; $self->{val} = $val; } sub descend { my $self = shift; my $got = shift; my $exp = $self->{val}; my $blessed = blessed($got); return Test::Deep::descend($blessed, Test::Deep::shallow($exp)); } sub render_stack { my $self = shift; my $var = shift; return "blessed($var)" } sub renderGot { my $self = shift; my $got = shift; $self->SUPER::renderGot(blessed($got)); } 1; Test-Deep-1.126/lib/Test/Deep/Boolean.pm000644 000767 000024 00000001056 12743560227 017713 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::Boolean; use Test::Deep::Cmp; sub init { my $self = shift; $self->{val} = shift() ? 1 : 0; } sub descend { my $self = shift; my $got = shift; return !( $got xor $self->{val} ); } sub diag_message { my $self = shift; my $where = shift; return "Comparing $where as a boolean"; } sub renderExp { my $self = shift; $self->renderGot($self->{val}); } sub renderGot { my $self = shift; my $val = shift; return ($val ? "true" : "false")." (".Test::Deep::render_val($val).")"; } 1; Test-Deep-1.126/lib/Test/Deep/Cache/000755 000767 000024 00000000000 13032230377 016767 5ustar00rjbsstaff000000 000000 Test-Deep-1.126/lib/Test/Deep/Cache.pm000644 000767 000024 00000002010 12743560227 017326 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::Cache; use Test::Deep::Cache::Simple; sub new { my $pkg = shift; my $self = bless {}, $pkg; $self->{expects} = [Test::Deep::Cache::Simple->new]; $self->{normal} = [Test::Deep::Cache::Simple->new]; $self->local; return $self; } sub add { my $self = shift; my $type = $self->type; $self->{$type}->[-1]->add(@_); } sub cmp { # go through all the caches to see if we know this one my $self = shift; my $type = $self->type; foreach my $cache (@{$self->{$type}}) { return 1 if $cache->cmp(@_); } return 0 } sub local { my $self = shift; foreach my $type (qw( expects normal )) { push(@{$self->{$type}}, Test::Deep::Cache::Simple->new); } } sub finish { my $self = shift; my $keep = shift; foreach my $type (qw( expects normal )) { my $caches = $self->{$type}; my $last = pop @$caches; $caches->[-1]->absorb($last) if $keep; } } sub type { return $Test::Deep::Expects ? "expects" : "normal"; } 1; Test-Deep-1.126/lib/Test/Deep/Class.pm000644 000767 000024 00000000553 12743560227 017402 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::Class; use Test::Deep::Cmp; sub init { my $self = shift; my $snobby = shift; my $val = shift; $self->{snobby} = $snobby; $self->{val} = $val; } sub descend { my $self = shift; my $got = shift; local $Test::Deep::Snobby = $self->{snobby}; Test::Deep::wrap($self->{val})->descend($got); } 1; Test-Deep-1.126/lib/Test/Deep/Cmp.pm000644 000767 000024 00000002201 12743560227 017044 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::Cmp; use overload '&' => \&make_all, '|' => \&make_any, '""' => \&string, fallback => 1, ; use Scalar::Util (); sub import { my $pkg = shift; my $callpkg = caller(); if ($callpkg =~ /^Test::Deep::/) { no strict 'refs'; push @{$callpkg."::ISA"}, $pkg; } } sub new { my $pkg = shift; my $self = bless {}, $pkg; $self->init(@_); return $self; } sub init { } sub make_all { my ($e1, $e2) = @_; return Test::Deep::all($e1, $e2); } sub make_any { my ($e1, $e2) = @_; return Test::Deep::any($e1, $e2); } sub cmp { my ($a1, $a2, $rev) = @_; ($a1, $a2) = ($a2, $a1) if $rev; return (overload::StrVal($a1) cmp overload::StrVal($a2)); } sub string { my $self = shift; return overload::StrVal($self); } sub render_stack { my $self = shift; my $var = shift; return $var; } sub renderExp { my $self = shift; return $self->renderGot($self->{val}); } sub renderGot { my $self = shift; return Test::Deep::render_val(@_); } sub reset_arrow { return 1; } sub data { my $self = shift; return $Test::Deep::Stack->getLast; } 1; Test-Deep-1.126/lib/Test/Deep/Code.pm000644 000767 000024 00000001301 12743560227 017177 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::Code; use Test::Deep::Cmp; sub init { my $self = shift; my $code = shift || die "No coderef supplied"; $self->{code} = $code; } sub descend { my $self = shift; my $got = shift; my ($ok, $diag) = &{$self->{code}}($got); $self->data->{diag} = $diag; return $ok; } sub diagnostics { my $self = shift; my ($where, $last) = @_; my $error = $last->{diag}; my $data = Test::Deep::render_val($last->{got}); my $diag = <{val} = $val; } sub descend { my $self = shift; my $got = shift; my $exp = $self->{val}; my $data = $self->data; return 0 unless Test::Deep::descend($got, $self->hash_keys($exp)); return 0 unless $self->test_class($got); return Test::Deep::descend($got, $self->hash_elements($exp)); } sub hash_elements { require Test::Deep::HashElements; my $self = shift; return Test::Deep::HashElements->new(@_); } sub hash_keys { require Test::Deep::HashKeys; my $self = shift; my $exp = shift; return Test::Deep::HashKeys->new(keys %$exp); } sub reset_arrow { return 0; } package Test::Deep::SuperHash; use base 'Test::Deep::Hash'; sub hash_elements { require Test::Deep::HashElements; my $self = shift; return Test::Deep::SuperHashElements->new(@_); } sub hash_keys { require Test::Deep::HashKeys; my $self = shift; my $exp = shift; return Test::Deep::SuperHashKeys->new(keys %$exp); } package Test::Deep::SubHash; use base 'Test::Deep::Hash'; sub hash_elements { require Test::Deep::HashElements; my $self = shift; return Test::Deep::SubHashElements->new(@_); } sub hash_keys { require Test::Deep::HashKeys; my $self = shift; my $exp = shift; return Test::Deep::SubHashKeys->new(keys %$exp); } 1; Test-Deep-1.126/lib/Test/Deep/HashEach.pm000644 000767 000024 00000000506 12743560227 017777 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::HashEach; use Test::Deep::Cmp; sub init { my $self = shift; my $val = shift; $self->{val} = $val; } sub descend { my $self = shift; my $got = shift; my %exp; @exp{keys %$got} = ($self->{val}) x (keys %$got); return Test::Deep::descend($got, \%exp); } 1; Test-Deep-1.126/lib/Test/Deep/HashElements.pm000644 000767 000024 00000002363 12743560227 020716 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::HashElements; use Test::Deep::Ref; sub init { my $self = shift; my $val = shift; $self->{val} = $val; } sub descend { my $self = shift; my $got = shift; my $exp = $self->{val}; my $data = $self->data; my $master = $self->getMaster($got, $exp); foreach my $key (keys %$master) { $data->{index} = $key; my $got_elem = exists $got->{$key} ? $got->{$key} : $Test::Deep::DNE; my $exp_elem = exists $exp->{$key} ? $exp->{$key} : $Test::Deep::DNE; next if Test::Deep::descend($got_elem, $exp_elem); return 0; } return 1; } sub getMaster { my $self = shift; my ($got, $exp) = @_; return keys %$got > keys %$exp ? $got : $exp; } sub render_stack { my $self = shift; my ($var, $data) = @_; $var .= "->" unless $Test::Deep::Stack->incArrow; $var .= '{"'.quotemeta($data->{index}).'"}'; return $var; } sub reset_arrow { return 0; } package Test::Deep::SuperHashElements; use base 'Test::Deep::HashElements'; sub getMaster { my $self = shift; my ($got, $exp) = @_; return $exp; } package Test::Deep::SubHashElements; use base 'Test::Deep::HashElements'; sub getMaster { my $self = shift; my ($got, $exp) = @_; return $got; } 1; Test-Deep-1.126/lib/Test/Deep/HashKeys.pm000644 000767 000024 00000001747 12743560227 020062 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::HashKeys; use Test::Deep::Ref; sub init { my $self = shift; my %keys; @keys{@_} = (); $self->{val} = \%keys; $self->{keys} = [sort @_]; } sub descend { my $self = shift; my $got = shift; my $exp = $self->{val}; return 0 unless $self->test_reftype($got, "HASH"); return Test::Deep::descend($got, $self->hashkeysonly($exp)); } sub hashkeysonly { require Test::Deep::HashKeysOnly; my $self = shift; my $exp = shift; return Test::Deep::HashKeysOnly->new(keys %$exp) } package Test::Deep::SuperHashKeys; use base 'Test::Deep::HashKeys'; sub hashkeysonly { require Test::Deep::HashKeysOnly; my $self = shift; my $exp = shift; return Test::Deep::SuperHashKeysOnly->new(keys %$exp) } package Test::Deep::SubHashKeys; use base 'Test::Deep::HashKeys'; sub hashkeysonly { require Test::Deep::HashKeysOnly; my $self = shift; my $exp = shift; return Test::Deep::SubHashKeysOnly->new(keys %$exp) } 1; Test-Deep-1.126/lib/Test/Deep/HashKeysOnly.pm000644 000767 000024 00000003005 12743560227 020711 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::HashKeysOnly; use Test::Deep::Ref; sub init { my $self = shift; my %keys; @keys{@_} = (); $self->{val} = \%keys; $self->{keys} = [sort @_]; } sub descend { my $self = shift; my $hash = shift; my $data = $self->data; my $exp = $self->{val}; my %got; @got{keys %$hash} = (); my @missing; my @extra; while (my ($key, $value) = each %$exp) { if (exists $got{$key}) { delete $got{$key}; } else { push(@missing, $key); } } my @diags; if (@missing and (not $self->ignoreMissing)) { push(@diags, "Missing: ".nice_list(\@missing)); } if (%got and (not $self->ignoreExtra)) { push(@diags, "Extra: ".nice_list([keys %got])); } if (@diags) { $data->{diag} = join("\n", @diags); return 0; } return 1; } sub diagnostics { my $self = shift; my ($where, $last) = @_; my $type = $self->{IgnoreDupes} ? "Set" : "Bag"; my $error = $last->{diag}; my $diag = <SUPER::new; sub new { return $Singleton; } sub descend { return 1; } 1; Test-Deep-1.126/lib/Test/Deep/Isa.pm000644 000767 000024 00000001032 12743560227 017042 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::Isa; use Test::Deep::Cmp; use Scalar::Util; sub init { my $self = shift; my $val = shift; $self->{val} = $val; } sub descend { my $self = shift; my $got = shift; return Scalar::Util::blessed($got) ? $got->isa($self->{val}) : ref($got) eq $self->{val}; } sub diag_message { my $self = shift; my $where = shift; return "Checking class of $where with isa()"; } sub renderExp { my $self = shift; return "blessed into or ref of type '$self->{val}'"; } 1; Test-Deep-1.126/lib/Test/Deep/ListMethods.pm000644 000767 000024 00000000440 12743560227 020567 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::ListMethods; use base 'Test::Deep::Methods'; sub call_method { my $self = shift; return [$self->SUPER::call_method(@_)]; } sub render_stack { my $self = shift; my $var = $self->SUPER::render_stack(@_); return "[$var]"; } 1; Test-Deep-1.126/lib/Test/Deep/Methods.pm000644 000767 000024 00000002440 13032230313 017713 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::Methods; use Test::Deep::Cmp; use Scalar::Util; sub init { my $self = shift; # get them all into [$name,@args] => $value format my @methods; while (@_) { my $name = shift; my $value = shift; push(@methods, [ ref($name) ? $name : [ $name ], $value ] ); } $self->{methods} = \@methods; } sub descend { my $self = shift; my $got = shift; my $data = $self->data; foreach my $method (@{$self->{methods}}) { $data->{method} = $method; my ($call, $exp_res) = @$method; my ($name, @args) = @$call; local $@; my $got_res; if (! eval { $got_res = $self->call_method($got, $call); 1 }) { die $@ unless $@ =~ /\ACan't locate object method "\Q$name"/; $got_res = $Test::Deep::DNE; } next if Test::Deep::descend($got_res, $exp_res); return 0; } return 1; } sub call_method { my $self = shift; my ($got, $call) = @_; my ($name, @args) = @$call; return $got->$name(@args); } sub render_stack { my $self = shift; my ($var, $data) = @_; my $method = $data->{method}; my ($call, $expect) = @$method; my ($name, @args) = @$call; my $args = @args ? "(".join(", ", @args).")" : ""; $var .= "->$name$args"; return $var; } 1; Test-Deep-1.126/lib/Test/Deep/MM.pm000644 000767 000024 00000001632 12743560227 016645 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::MM; sub import { my $self = shift; my ($pkg) = caller(); my $mpkg = $pkg."::Methods"; foreach my $attr (@_) { if ($attr =~ /^[a-z]/) { no strict 'refs'; *{$mpkg."::$attr"} = \&{$attr}; } else { my $get_name = $mpkg."::get$attr"; my $set_name = $mpkg."::set$attr"; my $get_sub = sub { return $_[0]->{$attr}; }; my $set_sub = sub { return $_[0]->{$attr} = $_[1]; }; { no strict 'refs'; *$get_name = $get_sub; *$set_name = $set_sub; push(@{$pkg."::ISA"}, $mpkg); } } } } sub new { my $pkg = shift; my $self = bless {}, $pkg; $self->init(@_); return $self; } sub init { my $self = shift; while (@_) { my $name = shift || confess("No name"); my $method = "set$name"; $self->$method(shift); } } 1; Test-Deep-1.126/lib/Test/Deep/None.pm000644 000767 000024 00000001525 12743560227 017234 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::None; use Test::Deep::Cmp; sub init { my $self = shift; my @list = map { eval { $_->isa('Test::Deep::None') } ? @{ $_->{val} } : Test::Deep::wrap($_) } @_; $self->{val} = \@list; } sub descend { my $self = shift; my $got = shift; foreach my $cmp (@{$self->{val}}) { return 0 if Test::Deep::eq_deeply_cache($got, $cmp); } return 1; } sub renderExp { my $self = shift; my $expect = $self->{val}; my $things = join(", ", map {$_->renderExp} @$expect); return "None of ( $things )"; } sub diagnostics { my $self = shift; my ($where, $last) = @_; my $got = $self->renderGot($last->{got}); my $exp = $self->renderExp; my $diag = <can("import"); # make the stack look like it should for use Test::Deep my $pkg = shift; unshift(@_, "Test::Deep"); goto &$import; } 1; =head1 NAME Test::Deep::NoTest - Use Test::Deep outside of the testing framework =head1 SYNOPSIS use Test::Deep::NoTest; if (eq_deeply($a, $b)) { print "they were deeply equal\n"; } =head1 DESCRIPTION This exports all the same things as Test::Deep but it does not load Test::Builder so it can be used in ordinary non-test situations. Test-Deep-1.126/lib/Test/Deep/Number.pm000644 000767 000024 00000002100 12743560227 017553 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::Number; use Test::Deep::Cmp; use Scalar::Util; sub init { my $self = shift; $self->{val} = shift(@_) + 0; $self->{tolerance} = shift; } sub descend { my $self = shift; my $got = shift; $self->data->{got_string} = $got; { no warnings 'numeric'; $got += 0; } $self->data->{got} = $got; if (defined(my $tolerance = $self->{tolerance})) { return abs($got - $self->{val}) <= $tolerance; } else { return $got == $self->{val}; } } sub diag_message { my $self = shift; my $where = shift; return "Comparing $where as a number"; } sub renderGot { my $self = shift; my $val = shift; my $got_string = $self->data->{got_string}; if ("$val" ne "$got_string") { $got_string = $self->SUPER::renderGot($got_string); return "$val ($got_string)" } else { return $val; } } sub renderExp { my $self = shift; my $exp = $self->{val}; if (defined(my $tolerance = $self->{tolerance})) { return "$exp +/- $tolerance"; } else { return $exp; } } 1; Test-Deep-1.126/lib/Test/Deep/Obj.pm000644 000767 000024 00000001012 12743560227 017036 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::Obj; use Test::Deep::Cmp; use Scalar::Util; sub init { my $self = shift; my $val = shift; $self->{val} = $val; } sub descend { my $self = shift; my $got = shift; return Scalar::Util::blessed($got) && $got->isa($self->{val}); } sub diag_message { my $self = shift; my $where = shift; return "Checking class of $where with isa()"; } sub renderExp { my $self = shift; return "blessed into '$self->{val}' or subclass of '$self->{val}'"; } 1; Test-Deep-1.126/lib/Test/Deep/Ref.pm000644 000767 000024 00000000752 12743560227 017052 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::Ref; use Test::Deep::Cmp; use Scalar::Util qw( blessed ); sub test_class { my $self = shift; my $got = shift; my $exp = $self->{val}; if ($Test::Deep::Snobby) { return Test::Deep::descend($got, Test::Deep::blessed(blessed($exp))); } else { return 1; } } sub test_reftype { my $self = shift; my $got = shift; my $reftype = shift; return Test::Deep::descend($got, Test::Deep::reftype($reftype)); } 1; Test-Deep-1.126/lib/Test/Deep/RefType.pm000644 000767 000024 00000001043 12743560227 017706 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::RefType; use Test::Deep::Cmp; use Scalar::Util qw( reftype ); sub init { my $self = shift; $self->{val} = shift; } sub descend { my $self = shift; my $got = shift; my $exp = $self->{val}; my $reftype = reftype($got); return Test::Deep::descend($reftype, Test::Deep::shallow($exp)); } sub render_stack { my $self = shift; my $var = shift; return "reftype($var)"; } sub renderGot { my $self = shift; my $got = shift; $self->SUPER::renderGot(reftype($got)); } 1; Test-Deep-1.126/lib/Test/Deep/Regexp.pm000644 000767 000024 00000002600 13032230313 017540 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::Regexp; use Test::Deep::Cmp; use Test::Deep::RegexpMatches; sub init { my $self = shift; my $val = shift; $val = ref $val ? $val : qr/$val/; $self->{val} = $val; if (my $matches = shift) { $self->{matches} = Test::Deep::regexpmatches($matches, $val); $self->{flags} = shift || ""; } } sub descend { my $self = shift; my $got = shift; my $re = $self->{val}; if (my $match_exp = $self->{matches}) { my $flags = $self->{flags}; my @match_got; if ($flags eq "g") { @match_got = $got =~ /$re/g; } else { @match_got = $got =~ /$re/; } if (@match_got) { return Test::Deep::descend(\@match_got, $match_exp); } else { return 0; } } else { return ($got =~ $re) ? 1 : 0; } } sub diag_message { my $self = shift; my $where = shift; return "Using Regexp on $where"; } sub render_stack1 { my $self = shift; my $stack = shift; return "($stack =~ $self->{regex})"; } sub renderExp { my $self = shift; return "$self->{val}"; } sub renderGot { my $self = shift; my $got = shift; if (defined (my $class = Scalar::Util::blessed($got))) { my $ostr = qq{$got}; if ($ostr ne overload::StrVal($got)) { return qq{'$ostr' (instance of $class)}; } } return Test::Deep::render_val($got); } 1; Test-Deep-1.126/lib/Test/Deep/RegexpMatches.pm000644 000767 000024 00000001226 12743560227 021072 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::RegexpMatches; use Test::Deep::Array; use base 'Test::Deep::Array'; use Scalar::Util qw( blessed ); sub init { my $self = shift; my $val = shift; $val = Test::Deep::array($val) unless blessed($val) and $val->isa("Test::Deep::Cmp"); $self->{val} = $val; $self->{regex} = shift; } sub descend { my $self = shift; my $got = shift; return Test::Deep::descend($got, $self->{val}); } sub render_stack { my $self = shift; my $stack = shift; $stack = "[$stack =~ $self->{regex}]"; return $stack; # return $self->SUPER::render_stack($stack); } sub reset_arrow { return 1; } 1; Test-Deep-1.126/lib/Test/Deep/RegexpOnly.pm000644 000767 000024 00000001011 12743560227 020417 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::RegexpOnly; use Test::Deep::Cmp; use Scalar::Util qw( blessed ); sub init { my $self = shift; my $val = shift; $val = ref $val ? $val : qr/$val/; $self->{val} = $val; } sub descend { my $self = shift; my $got = shift; my $re = $self->{val}; return $got =~ $self->{val} ? 1 : 0; } sub diag_message { my $self = shift; my $where = shift; return "Using Regexp on $where"; } sub renderExp { my $self = shift; return "$self->{val}"; } 1; Test-Deep-1.126/lib/Test/Deep/RegexpRef.pm000644 000767 000024 00000001177 12743560227 020227 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::RegexpRef; use Test::Deep::Ref; use Test::Deep::RegexpVersion; sub init { my $self = shift; my $val = shift; $self->{val} = $val; } sub descend { my $self = shift; my $got = shift; my $exp = $self->{val}; if ($Test::Deep::RegexpVersion::OldStyle) { return 0 unless $self->test_class($got, "Regexp"); return 0 unless $self->test_reftype($got, "SCALAR"); } else { return 0 unless $self->test_reftype($got, "REGEXP"); } return Test::Deep::descend($got, Test::Deep::regexprefonly($exp)); } sub renderGot { my $self = shift; return shift().""; } 1; Test-Deep-1.126/lib/Test/Deep/RegexpRefOnly.pm000644 000767 000024 00000000647 12743560227 021072 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::RegexpRefOnly; use Test::Deep::Ref; sub init { my $self = shift; my $val = shift; $self->{val} = $val; } sub descend { my $self = shift; my $got = shift; my $exp = $self->{val}; return $got eq $exp; } sub render_stack { my $self = shift; my ($var, $data) = @_; return "m/$var/"; } sub renderGot { my $self = shift; return shift().""; } 1; Test-Deep-1.126/lib/Test/Deep/RegexpVersion.pm000644 000767 000024 00000000430 12132270362 021115 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::RegexpVersion; # Older versions of Perl treated Regexp refs as opaque scalars blessed # into the "Regexp" class. Several bits of code need this so we # centralise the test for that kind of version. our $OldStyle = ($] < 5.011); 1; Test-Deep-1.126/lib/Test/Deep/ScalarRef.pm000644 000767 000024 00000000660 12743560227 020176 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::ScalarRef; use Test::Deep::Ref; sub init { my $self = shift; my $val = shift; $self->{val} = $val; } sub descend { my $self = shift; my $got = shift; my $exp = $self->{val}; return 0 unless $self->test_class($got); return 0 unless $self->test_reftype($got, Scalar::Util::reftype($exp)); return Test::Deep::descend($got, Test::Deep::scalarrefonly($exp)); } 1; Test-Deep-1.126/lib/Test/Deep/ScalarRefOnly.pm000644 000767 000024 00000000600 12743560227 021032 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::ScalarRefOnly; use Test::Deep::Cmp; sub init { my $self = shift; my $val = shift; $self->{val} = $val; } sub descend { my $self = shift; my $got = shift; my $exp = $self->{val}; return Test::Deep::descend($$got, $$exp); } sub render_stack { my $self = shift; my ($var, $data) = @_; return "\${$var}"; } 1; Test-Deep-1.126/lib/Test/Deep/Set.pm000644 000767 000024 00000007160 13032230313 017047 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::Set; use Test::Deep::Cmp; sub init { my $self = shift; $self->{IgnoreDupes} = shift; $self->{SubSup} = shift; $self->{val} = []; $self->add(@_); } sub descend { my $self = shift; my $d1 = shift; my $d2 = $self->{val}; my $IgnoreDupes = $self->{IgnoreDupes}; my $data = $self->data; my $SubSup = $self->{SubSup}; my $type = $IgnoreDupes ? "Set" : "Bag"; my $diag; if (ref $d1 ne 'ARRAY') { my $got = Test::Deep::render_val($d1); $diag = <= 0; $i--) { if (Test::Deep::eq_deeply_cache($got[$i], $expect)) { $found = 1; push(@found, $expect); splice(@got, $i, 1); last unless $IgnoreDupes; } } push(@missing, $expect) unless $found; } my @diags; if (@missing and $SubSup ne "sub" && $SubSup ne "none") { push(@diags, "Missing: ".nice_list(\@missing)); } if (@got and $SubSup ne "sup" && $SubSup ne "none") { my $got = __PACKAGE__->new($IgnoreDupes, "", @got); push(@diags, "Extra: ".nice_list($got->{val})); } if (@found and $SubSup eq "none") { my $found = __PACKAGE__->new($IgnoreDupes, "", @found); push(@diags, "Extra: ".nice_list($found->{val})); } $diag = join("\n", @diags); } if ($diag) { $data->{diag} = $diag; return 0; } else { return 1; } } sub diagnostics { my $self = shift; my ($where, $last) = @_; my $type = $self->{IgnoreDupes} ? "Set" : "Bag"; $type = "Sub$type" if $self->{SubSup} eq "sub"; $type = "Super$type" if $self->{SubSup} eq "sup"; $type = "NoneOf" if $self->{SubSup} eq "none"; my $error = $last->{diag}; my $diag = <{IgnoreDupes}; my $already = $self->{val}; local $Test::Deep::Expects = 1; foreach my $new_elem (@array) { my $want_push = 1; my $push_this = $new_elem; foreach my $old_elem (@$already) { if (Test::Deep::eq_deeply($new_elem, $old_elem)) { $push_this = $old_elem; $want_push = ! $IgnoreDupes; last; } } push(@$already, $push_this) if $want_push; } # so we can compare 2 Test::Deep::Set objects using array comparison @$already = sort {(defined $a ? $a : "") cmp (defined $b ? $b : "")} @$already; } sub nice_list { my $list = shift; my @scalars = grep ! ref $_, @$list; my $refs = grep ref $_, @$list; my @ref_string = "$refs reference" if $refs; $ref_string[0] .= "s" if $refs > 1; # sort them so we can predict the diagnostic output return join(", ", (map {Test::Deep::render_val($_)} sort {(defined $a ? $a : "") cmp (defined $b ? $b : "")} @scalars), @ref_string ); } sub compare { my $self = shift; my $other = shift; return 0 if $self->{IgnoreDupes} != $other->{IgnoreDupes}; # this works (kind of) because the arrays are sorted return Test::Deep::descend($self->{val}, $other->{val}); } 1; Test-Deep-1.126/lib/Test/Deep/Shallow.pm000644 000767 000024 00000001125 12763626143 017744 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::Shallow; use Test::Deep::Cmp; use Scalar::Util qw( refaddr ); sub init { my $self = shift; my $val = shift; $self->{val} = $val; } sub descend { my $self = shift; my $got = shift; my $exp = $self->{val}; my $ok; if (!defined $got and !defined $exp) { $ok = 1; } elsif (defined $got xor defined $exp) { $ok = 0; } elsif (ref $got and ref $exp) { $ok = refaddr($got) == refaddr($exp); } elsif (ref $got xor ref $exp) { $ok = 0; } else { $ok = $got eq $exp; } return $ok; } 1; Test-Deep-1.126/lib/Test/Deep/Stack.pm000644 000767 000024 00000002064 12743560227 017401 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::Stack; use Carp qw( confess ); use Scalar::Util; use Test::Deep::MM qw( new init Stack Arrow ); sub init { my $self = shift; $self->SUPER::init(@_); $self->setStack([]) unless $self->getStack; } sub push { my $self = shift; push(@{$self->getStack}, @_); } sub pop { my $self = shift; return pop @{$self->getStack}; } sub render { my $self = shift; my $var = shift; my $stack = $self->getStack; $self->setArrow(0); foreach my $data (@$stack) { my $exp = $data->{exp}; if (Scalar::Util::blessed($exp) and $exp->isa("Test::Deep::Cmp")) { $var = $exp->render_stack($var, $data); $self->setArrow(0) if $exp->reset_arrow; } else { confess "Don't know how to render '$exp'"; } } return $var; } sub getLast { my $self = shift; return $self->getStack->[-1]; } sub incArrow { my $self = shift; my $a = $self->getArrow; $self->setArrow($a + 1); return $a; } sub length { my $self = shift; return @{$self->getStack} + 0; } 1; Test-Deep-1.126/lib/Test/Deep/String.pm000644 000767 000024 00000000561 12743560227 017602 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::String; use Test::Deep::Cmp; sub init { my $self = shift; $self->{val} = shift; } sub descend { my $self = shift; my $got = shift().""; $self->data->{got} = $got; return $got eq $self->{val}; } sub diag_message { my $self = shift; my $where = shift; return "Comparing $where as a string"; } 1; Test-Deep-1.126/lib/Test/Deep/Cache/Simple.pm000644 000767 000024 00000002265 13032230313 020551 0ustar00rjbsstaff000000 000000 use strict; use warnings; package Test::Deep::Cache::Simple; use Carp qw( confess ); use Scalar::Util qw( refaddr ); BEGIN { if (grep /^weaken$/, @Scalar::Util::EXPORT_FAIL) { # we're running on a version of perl that has no weak refs, so we # just install a no-op sub for weaken instead of importing it *weaken = sub {}; } else { Scalar::Util->import('weaken'); } } sub new { my $pkg = shift; my $self = bless {}, $pkg; return $self; } sub add { my $self = shift; my ($d1, $d2) = @_; { local $SIG{__DIE__}; local $@; # cannot weaken read only refs, no harm if we can't as they never # disappear eval{weaken($d1)}; eval{weaken($d2)}; } $self->{fn_get_key(@_)} = [$d1, $d2]; } sub cmp { my $self = shift; my $key = fn_get_key(@_); my $pair = $self->{$key}; # are both weakened refs still valid, if not delete this entry if (ref($pair->[0]) and ref($pair->[1])) { return 1; } else { delete $self->{$key}; return 0; } } sub absorb { my $self = shift; my $other = shift; @{$self}{keys %$other} = values %$other; } sub fn_get_key { return join(",", sort (map {refaddr($_)} @_)); } 1;