diff options
| author | Lorry Tar Creator <lorry-tar-importer@lorry> | 2014-12-10 13:34:52 +0000 |
|---|---|---|
| committer | Lorry Tar Creator <lorry-tar-importer@lorry> | 2014-12-10 13:34:52 +0000 |
| commit | 8fddd4400d09891094843fe9e77fec74e4510c67 (patch) | |
| tree | 23dbb27d11e56cf6586d93b091c708fa111a7a2d | |
| download | Data-Compare-tarball-master.tar.gz | |
Data-Compare-1.25HEADData-Compare-1.25master
35 files changed, 2443 insertions, 0 deletions
diff --git a/ARTISTIC.txt b/ARTISTIC.txt new file mode 100644 index 0000000..5f22124 --- /dev/null +++ b/ARTISTIC.txt @@ -0,0 +1,131 @@ + + + + + The "Artistic License" + + Preamble + +The intent of this document is to state the conditions under which a +Package may be copied, such that the Copyright Holder maintains some +semblance of artistic control over the development of the package, +while giving the users of the package the right to use and distribute +the Package in a more-or-less customary fashion, plus the right to make +reasonable modifications. + +Definitions: + + "Package" refers to the collection of files distributed by the + Copyright Holder, and derivatives of that collection of files + created through textual modification. + + "Standard Version" refers to such a Package if it has not been + modified, or has been modified in accordance with the wishes + of the Copyright Holder as specified below. + + "Copyright Holder" is whoever is named in the copyright or + copyrights for the package. + + "You" is you, if you're thinking about copying or distributing + this Package. + + "Reasonable copying fee" is whatever you can justify on the + basis of media cost, duplication charges, time of people involved, + and so on. (You will not be required to justify it to the + Copyright Holder, but only to the computing community at large + as a market that must bear the fee.) + + "Freely Available" means that no fee is charged for the item + itself, though there may be fees involved in handling the item. + It also means that recipients of the item may redistribute it + under the same conditions they received it. + +1. You may make and give away verbatim copies of the source form of the +Standard Version of this Package without restriction, provided that you +duplicate all of the original copyright notices and associated disclaimers. + +2. You may apply bug fixes, portability fixes and other modifications +derived from the Public Domain or from the Copyright Holder. A Package +modified in such a way shall still be considered the Standard Version. + +3. You may otherwise modify your copy of this Package in any way, provided +that you insert a prominent notice in each changed file stating how and +when you changed that file, and provided that you do at least ONE of the +following: + + a) place your modifications in the Public Domain or otherwise make them + Freely Available, such as by posting said modifications to Usenet or + an equivalent medium, or placing the modifications on a major archive + site such as uunet.uu.net, or by allowing the Copyright Holder to include + your modifications in the Standard Version of the Package. + + b) use the modified Package only within your corporation or organization. + + c) rename any non-standard executables so the names do not conflict + with standard executables, which must also be provided, and provide + a separate manual page for each non-standard executable that clearly + documents how it differs from the Standard Version. + + d) make other distribution arrangements with the Copyright Holder. + +4. You may distribute the programs of this Package in object code or +executable form, provided that you do at least ONE of the following: + + a) distribute a Standard Version of the executables and library files, + together with instructions (in the manual page or equivalent) on where + to get the Standard Version. + + b) accompany the distribution with the machine-readable source of + the Package with your modifications. + + c) give non-standard executables non-standard names, and clearly + document the differences in manual pages (or equivalent), together + with instructions on where to get the Standard Version. + + d) make other distribution arrangements with the Copyright Holder. + +5. You may charge a reasonable copying fee for any distribution of this +Package. You may charge any fee you choose for support of this +Package. You may not charge a fee for this Package itself. However, +you may distribute this Package in aggregate with other (possibly +commercial) programs as part of a larger (possibly commercial) software +distribution provided that you do not advertise this Package as a +product of your own. You may embed this Package's interpreter within +an executable of yours (by linking); this shall be construed as a mere +form of aggregation, provided that the complete Standard Version of the +interpreter is so embedded. + +6. The scripts and library files supplied as input to or produced as +output from the programs of this Package do not automatically fall +under the copyright of this Package, but belong to whoever generated +them, and may be sold commercially, and may be aggregated with this +Package. If such scripts or library files are aggregated with this +Package via the so-called "undump" or "unexec" methods of producing a +binary executable image, then distribution of such an image shall +neither be construed as a distribution of this Package nor shall it +fall under the restrictions of Paragraphs 3 and 4, provided that you do +not represent such an executable image as a Standard Version of this +Package. + +7. C subroutines (or comparably compiled subroutines in other +languages) supplied by you and linked into this Package in order to +emulate subroutines and variables of the language defined by this +Package shall not be considered part of this Package, but are the +equivalent of input as in Paragraph 6, provided these subroutines do +not change the language in any way that would cause it to fail the +regression tests for the language. + +8. Aggregation of this Package with a commercial distribution is always +permitted provided that the use of this Package is embedded; that is, +when no overt attempt is made to make this Package's interfaces visible +to the end user of the commercial distribution. Such use shall not be +construed as a distribution of this Package. + +9. The name of the Copyright Holder may not be used to endorse or promote +products derived from this software without specific prior written permission. + +10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED +WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. + + The End diff --git a/CHANGELOG b/CHANGELOG new file mode 100644 index 0000000..9d64c09 --- /dev/null +++ b/CHANGELOG @@ -0,0 +1,78 @@ +1.25 2013-04-15 DCANTRELL Add Gianni Ceccarelli's tests and patch + to Use refaddr & reftype to "do the right + thing" when comparing objects that overload + numification and stringification + +1.24 2014-04-05 DCANTRELL Bump the required JSON.pm version for + tests - something's a bit broken around + about v 2.53 + +1.23 2013-09-26 DCANTRELL Add David Muir Sharnoff's tests for + really big data structures (but not yet + working); + Check for taint-mode less insanely, thanks + to Ilmari; + Don't delay loading File::Find::Rule (see + RT 87554) + +1.22 2010-02-12 DCANTRELL Previous release was in error. Instead, fix + the problem, circular structures now + compare equal, no matter what the starting + point (see RT 52836) + +1.2102 2010-02-01 DCANTRELL Add doco about structural vs data equivalence + (see RT 52836) + +1.2101 2009-05-05 DCANTRELL Add full licence text; -I fix in taint tests + to cope with paths with a space in 'em + (thanks to MATISSE, see RT 45676) + +1.21 2008-08-21 DCANTRELL Extra tests added in 1.20 now skip with + really old JSON + +1.20 2008-08-21 DCANTRELL Added test for bug reported by Saritha + Nalagandla (no bug found, but you can never + have too many tests!) + Fixed bug in PERL5LIB splitting in taint test + (thanks to ADAMK, see RT 38319) + +1.19 2008-05-12 DCANTRELL Can now compare structures with repeats in 'em + like [\$z, \$z] (bug reported by Todd Hepler) + Minor code tidying + +1.18 2008-01-15 DCANTRELL Got rid of prototypes; + File::Find::Rule now only loads when needed; + Plugins can be ignored with a null import() list; + Explicitly documented the auto-export; + Got rid of diagnostics pragma + +0.17 2007-08-07 DCANTRELL Added POD test + Fixed buggy POD :-) + Fixed problem with taint testing when PERL5LIB + is set (thanks to Andreas Koenig for finding + the bug) + Minor doco fiddling +0.16 2007-02-27 DCANTRELL Taint test and detection made less stupid +0.15 2007-02-25 DCANTRELL Skip taint tests on perl 5.6 and earlier +0.14 2006-11-01 DCANTRELL Fixed deeply nested objects (see rt.cpan #6966) +0.13 2004-11-09 DCANTRELL Oops, left in some debugging output +0.12 2004-11-09 DCANTRELL Fixed recursion detection bug - wasn't decrementing + counter properly! (thanks to Jenda for the bug + report) +0.11 2004-06-02 DCANTRELL Now taint-safe - in taint mode there's no plugins + (thanks Gabor Szabo for reporting the bug) +0.10 2004-03-13 DCANTRELL Replaced recursion detection with Rusty Conover's + much better implementation. +0.09 2004-02-23 DCANTRELL Added deep recursion detection. +0.08 2004-01-20 DCANTRELL Added options, and ignore_hash_keys +0.07 2004-01-07 DCANTRELL Bugfix to avoid loading same plugin more than + once. S::P plugin renamed so it would work with + this bugfix. Clean-up of code. Fix minor doc-bug + in lib/Data/Compare/Plugins.pod. +0.06 2004-01-06 DCANTRELL Added plugins, moved Scalar::Properties support + into a plugin (plugins were Jim Cromie's idea) +0.05 2003-12-30 DCANTRELL Applied mike@very.puzzling.org's patch for + comparing compiled regexps +0.04 2003-12-24 DCANTRELL Applied aef's patch to correctly compare refs to + refs to stuff +0.03 2003-12-23 DCANTRELL Added special-case handling for Scalar::Properties diff --git a/GPL2.txt b/GPL2.txt new file mode 100644 index 0000000..d511905 --- /dev/null +++ b/GPL2.txt @@ -0,0 +1,339 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Lesser General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + <one line to give the program's name and a brief idea of what it does.> + Copyright (C) <year> <name of author> + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along + with this program; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + <signature of Ty Coon>, 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. diff --git a/MAINTAINERS-NOTE b/MAINTAINERS-NOTE new file mode 100644 index 0000000..2dded23 --- /dev/null +++ b/MAINTAINERS-NOTE @@ -0,0 +1,29 @@ +Hi, this is your friendly neighbourhood co-maintainer DCANTRELL speaking. + +I persuaded the nice modules@perl.org people to make me a co-maintainer of +this module because I had patches to apply and the original author - Fabien +Tassin - seems to have gone AWOL. + +You will notice if you look at my review of Fabien's last version that I +have some criticism of his choice of interface. It is *not* my intention +to "fix" that. For better or worse, that is the current interface, and +that's the interface that plenty of existing code, mine included, is using. +To change it now after the module has been stable for so long would be +silly. + +I do not want to take Fabien's work away from him. If he shows up again +and would rather I didn't remain as a co-maintainer, then that's just fine +by me. The less code I have to maintain the better as far as I'm concerned! +I only volunteered to maintain this because I use it a lot, and I got bit +by bugs. Well, not so much bugs, as unexpected happenings. In particular, +it didn't intelligently Do The Right Thing when comparing Scalar::Properties +objects. + +If I'd thought about what an S::P object was I would have realised what was +going to happen. So anyway, when I was patching Data::Compare to be a bit +more intelligent about S::Ps, I also spotted a potential bug to do with how +Fabien had used /o on a regex match, so I fixed that too. And then because +I'd been talking about this on IRC, Anthony Fisher contributed a patch to +fix some brokenness to do with how it handled references to refernces. + +Then I added features :-) diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..b7f37df --- /dev/null +++ b/MANIFEST @@ -0,0 +1,35 @@ +MANIFEST +README +CHANGELOG +MAINTAINERS-NOTE +Makefile.PL +TODO +lib/Data/Compare.pm +lib/Data/Compare/Plugins.pod +lib/Data/Compare/Plugins/Scalar/Properties.pm +t/compare.t +t/oo.t +t/opts-ignore-hash-keys.t +t/plugins.t +t/scalar-properties.t +t/taint.t +t/deep-recursion.t +t/deep-objects.t +t/realtainttest +t/pod.t +NOTES +t/noimport.t +t/noimport-register_plugins.t +t/duplicates.t +t/saritha-nalagandla-bug.t +t/saritha-nalagandla-bug/test082_updateevent_multipleinvitees.exp +t/saritha-nalagandla-bug/test082_updateevent_multipleinvitees.out +ARTISTIC.txt +GPL2.txt +t/coverage.sh +t/FIXME-large-structures.t +MANIFEST.SKIP +t/overload.t +t/lib/SpecialClass.pm +META.yml Module YAML meta-data (added by MakeMaker) +META.json Module JSON meta-data (added by MakeMaker) diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP new file mode 100644 index 0000000..44c2fad --- /dev/null +++ b/MANIFEST.SKIP @@ -0,0 +1,2 @@ +.travis.yml +^\.git diff --git a/META.json b/META.json new file mode 100644 index 0000000..8f1a04c --- /dev/null +++ b/META.json @@ -0,0 +1,50 @@ +{ + "abstract" : "unknown", + "author" : [ + "unknown" + ], + "dynamic_config" : 1, + "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.120351", + "license" : [ + "unknown" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : "2" + }, + "name" : "Data-Compare", + "no_index" : { + "directory" : [ + "t", + "inc" + ] + }, + "prereqs" : { + "build" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "configure" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "runtime" : { + "requires" : { + "File::Find::Rule" : "0.1", + "Scalar::Util" : "0" + } + } + }, + "release_status" : "stable", + "resources" : { + "bugtracker" : { + "web" : "https://github.com/DrHyde/perl-modules-Data-Compare/issues/new" + }, + "repository" : { + "url" : "https://github.com/DrHyde/perl-modules-Data-Compare" + } + }, + "version" : "1.25" +} diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..d39bd8b --- /dev/null +++ b/META.yml @@ -0,0 +1,26 @@ +--- +abstract: unknown +author: + - unknown +build_requires: + ExtUtils::MakeMaker: 0 +configure_requires: + ExtUtils::MakeMaker: 0 +dynamic_config: 1 +generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.120351' +license: unknown +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 +name: Data-Compare +no_index: + directory: + - t + - inc +requires: + File::Find::Rule: 0.1 + Scalar::Util: 0 +resources: + bugtracker: https://github.com/DrHyde/perl-modules-Data-Compare/issues/new + repository: https://github.com/DrHyde/perl-modules-Data-Compare +version: 1.25 diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..d1ed19c --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,18 @@ +use ExtUtils::MakeMaker qw(WriteMakefile); + +WriteMakefile( + NAME => 'Data::Compare', + META_MERGE => { + license => 'other', + resources => { + repository => 'https://github.com/DrHyde/perl-modules-Data-Compare', + bugtracker => 'https://github.com/DrHyde/perl-modules-Data-Compare/issues/new' + }, + }, + VERSION_FROM => "lib/Data/Compare.pm", + PREREQ_PM => { + File::Find::Rule => 0.10, + Scalar::Util => 0 + }, + clean => { FILES => '*.bak *.old mibs/*.dump lib/*/*~' }, +); @@ -0,0 +1,2 @@ +There is no t/pod-coverage.t cos the documentation's structure is + incompatible with it @@ -0,0 +1,10 @@ +This module compares arbitrary data structures to see if they are copies +of each other. + +To install, do the usual: + + perl Makefile.PL + make + make test + make install + @@ -0,0 +1,13 @@ +add tests to see if plugin loading fails appropriately + +fiddle so that we can: + optionally only load certain plugins + optionally load all plugins except foo bar and baz + default to loading all +the best way to do this is to have our own import() and do it at +use() time, so dumping Exporter + +be paranoid about plugins trampling on each other? + +what about plugins overriding default behaviour? + hehe, Data::Compare::Approximate :-) diff --git a/lib/Data/Compare.pm b/lib/Data/Compare.pm new file mode 100644 index 0000000..9e2ca6d --- /dev/null +++ b/lib/Data/Compare.pm @@ -0,0 +1,422 @@ +# Data::Compare - compare perl data structures +# Author: Fabien Tassin <fta@sofaraway.org> +# updated by David Cantrell <david@cantrell.org.uk> +# Copyright 1999-2001 Fabien Tassin <fta@sofaraway.org> +# portions Copyright 2003 - 2013 David Cantrell + +package Data::Compare; + +use strict; +use warnings; + +use vars qw(@ISA @EXPORT $VERSION $DEBUG %been_there); +use Exporter; +use Carp; +use Scalar::Util qw(tainted); +use File::Find::Rule; + +@ISA = qw(Exporter); +@EXPORT = qw(Compare); +$VERSION = 1.25; +$DEBUG = $ENV{PERL_DATA_COMPARE_DEBUG} || 0; + +my %handler; + +use Cwd; + +sub import { + register_plugins() unless tainted getcwd(); + __PACKAGE__->export_to_level(1, @EXPORT); +} + +# finds and registers plugins +sub register_plugins { + foreach my $file ( + File::Find::Rule->file()->name('*.pm')->in( + map { "$_/Data/Compare/Plugins" } + grep { -d "$_/Data/Compare/Plugins" } + @INC + ) + ) { + # all of this just to avoid loading the same plugin twice and + # generating a pile of warnings. Grargh! + $file =~ s!.*(Data/Compare/Plugins/.*)\.pm$!$1!; + $file =~ s!/!::!g; + # ignore badly named example from earlier version, oops + next if($file eq 'Data::Compare::Plugins::Scalar-Properties'); + my $requires = eval "require $file"; + next if($requires eq '1'); # already loaded this plugin? + + # not an arrayref? bail + if(ref($requires) ne 'ARRAY') { + warn("$file isn't a valid Data::Compare plugin (didn't return arrayref)\n"); + return; + } + # coerce into arrayref of arrayrefs if necessary + if(ref((@{$requires})[0]) ne 'ARRAY') { $requires = [$requires] } + + # register all the handlers + foreach my $require (@{$requires}) { + my($handler, $type1, $type2, $cruft) = reverse @{$require}; + $type2 = $type1 unless(defined($type2)); + ($type1, $type2) = sort($type1, $type2); + if(!defined($type1) || ref($type1) ne '' || !defined($type2) || ref($type2) ne '') { + warn("$file isn't a valid Data::Compare plugin (invalid type)\n"); + } elsif(defined($cruft)) { + warn("$file isn't a valid Data::Compare plugin (extra data)\n"); + } elsif(ref($handler) ne 'CODE') { + warn("$file isn't a valid Data::Compare plugin (no coderef)\n"); + } else { + $handler{$type1}{$type2} = $handler; + } + } + } +} + +sub new { + my $this = shift; + my $class = ref($this) || $this; + my $self = {}; + bless $self, $class; + $self->{'x'} = shift; + $self->{'y'} = shift; + return $self; +} + +sub Cmp { + my $self = shift; + + croak "Usage: DataCompareObj->Cmp(x, y)" unless $#_ == 1 || $#_ == -1; + my $x = shift || $self->{'x'}; + my $y = shift || $self->{'y'}; + + return Compare($x, $y); +} + +sub Compare { + croak "Usage: Data::Compare::Compare(x, y, [opts])\n" unless $#_ == 1 || $#_ == 2; + + my $x = shift; + my $y = shift; + my $opts = shift || {}; + my($xparent, $xpos, $yparent, $ypos) = map { + $opts->{$_} || '' + } qw(xparent xpos yparent ypos); + + my $rval = ''; + + if(!exists($opts->{recursion_detector})) { + %been_there = (); + $opts->{recursion_detector} = 0; + } + $opts->{recursion_detector}++; + + warn "Yaroo! deep recursion!\n" if($opts->{recursion_detector} == 99); + + if( + (ref($x) && exists($been_there{"$x-$xpos-$xparent"}) && $been_there{"$x-$xpos-$xparent"} > 1) || + (ref($y) && exists($been_there{"$y-$ypos-$yparent"}) && $been_there{"$y-$ypos-$yparent"} > 1) + ) { + $opts->{recursion_detector}--; + return 1; # we bail as soon as possible, so if we've *not* bailed and have got here, say we're OK and go to the next sub-structure + } else { + $been_there{"$x-$xpos-$xparent"}++ if(ref($x)); + $been_there{"$y-$ypos-$yparent"}++ if(ref($y)); + + $opts->{ignore_hash_keys} = { map { + ($_, 1) + } @{$opts->{ignore_hash_keys}} } if(ref($opts->{ignore_hash_keys}) eq 'ARRAY'); + + my $refx = ref $x; + my $refy = ref $y; + + if(exists($handler{$refx}) && exists($handler{$refx}{$refy})) { + $rval = &{$handler{$refx}{$refy}}($x, $y, $opts); + } elsif(exists($handler{$refy}) && exists($handler{$refy}{$refx})) { + $rval = &{$handler{$refy}{$refx}}($x, $y, $opts); + } + + elsif(!$refx && !$refy) { # both are scalars + if(defined $x && defined $y) { # both are defined + $rval = $x eq $y; + } else { $rval = !(defined $x || defined $y); } + } + elsif ($refx ne $refy) { # not the same type + $rval = 0; + } + elsif (Scalar::Util::refaddr($x) == Scalar::Util::refaddr($y)) { # exactly the same reference + $rval = 1; + } + elsif ($refx eq 'SCALAR' || $refx eq 'REF') { + $rval = Compare(${$x}, ${$y}, $opts); + } + elsif ($refx eq 'ARRAY') { + if ($#{$x} == $#{$y}) { # same length + my $i = -1; + $rval = 1; + for (@$x) { + $i++; + $rval = 0 unless Compare($x->[$i], $y->[$i], { %{$opts}, xparent => $x, xpos => $i, yparent => $y, ypos => $i}); + } + } + else { + $rval = 0; + } + } + elsif ($refx eq 'HASH') { + my @kx = grep { !$opts->{ignore_hash_keys}->{$_} } keys %$x; + my @ky = grep { !$opts->{ignore_hash_keys}->{$_} } keys %$y; # heh, KY + $rval = 1; + $rval = 0 unless scalar @kx == scalar @ky; + + for (@kx) { + next unless defined $x->{$_} || defined $y->{$_}; + $rval = 0 unless defined $y->{$_} && Compare($x->{$_}, $y->{$_}, { %{$opts}, xparent => $x, xpos => $_, yparent => $y, ypos => $_}); + } + } + elsif($refx eq 'Regexp') { + $rval = Compare($x.'', $y.'', $opts); + } + elsif ($refx eq 'CODE') { + $rval = 0; + } + elsif ($refx eq 'GLOB') { + $rval = 0; + } + else { # a package name (object blessed) + my $type = Scalar::Util::reftype($x); + if ($type eq 'HASH') { + my %x = %$x; + my %y = %$y; + $rval = Compare(\%x, \%y, { %{$opts}, xparent => $xparent, xpos => $xpos, yparent => $yparent, ypos => $ypos}); + $been_there{\%x."-$xpos-$xparent"}--; # decrement count for temp structures + $been_there{\%y."-$ypos-$yparent"}--; + } + elsif ($type eq 'ARRAY') { + my @x = @$x; + my @y = @$y; + $rval = Compare(\@x, \@y, { %{$opts}, xparent => $xparent, xpos => $xpos, yparent => $yparent, ypos => $ypos}); + $been_there{\@x."-$xpos-$xparent"}--; + $been_there{\@y."-$ypos-$yparent"}--; + } + elsif ($type eq 'SCALAR' || $type eq 'REF') { + my $x = ${$x}; + my $y = ${$y}; + $rval = Compare($x, $y, $opts); + # $been_there{\$x}--; + # $been_there{\$y}--; + } + elsif ($type eq 'GLOB') { + $rval = 0; + } + elsif ($type eq 'CODE') { + $rval = 0; + } + else { + croak "Can't handle $type type."; + $rval = 0; + } + } + } + $opts->{recursion_detector}--; + return $rval; +} + +sub plugins { + return { map { (($_ eq '') ? '[scalar]' : $_, [map { $_ eq '' ? '[scalar]' : $_ } keys %{$handler{$_}}]) } keys %handler }; +} + +sub plugins_printable { + my $r = "The following comparisons are available through plugins\n\n"; + foreach my $key (sort keys %handler) { + foreach(sort keys %{$handler{$key}}) { + $r .= join(":\t", map { $_ eq '' ? '[scalar]' : $_ } ($key, $_))."\n"; + } + } + return $r; +} + +1; + +=head1 NAME + +Data::Compare - compare perl data structures + +=head1 SYNOPSIS + + use Data::Compare; + + my $h1 = { 'foo' => [ 'bar', 'baz' ], 'FOO' => [ 'one', 'two' ] }; + my $h2 = { 'foo' => [ 'bar', 'barf' ], 'FOO' => [ 'one', 'two' ] }; + my @a1 = ('one', 'two'); + my @a2 = ('bar', 'baz'); + my %v = ( 'FOO', \@a1, 'foo', \@a2 ); + + # simple procedural interface + print 'structures of $h1 and \%v are ', + Compare($h1, \%v) ? "" : "not ", "identical.\n"; + + print 'structures of $h1 and $h2 are ', + Compare($h1, $h2, { ignore_hash_keys => [qw(foo)] }) ? '' : 'not ', + "close enough to identical.\n"; + + # OO usage + my $c = new Data::Compare($h1, \%v); + print 'structures of $h1 and \%v are ', + $c->Cmp ? "" : "not ", "identical.\n"; + # or + my $c = new Data::Compare; + print 'structures of $h and \%v are ', + $c->Cmp($h1, \%v) ? "" : "not ", "identical.\n"; + +=head1 DESCRIPTION + +Compare two perl data structures recursively. Returns 0 if the +structures differ, else returns 1. + +A few data types are treated as special cases: + +=over 4 + +=item Scalar::Properties objects + +This has been moved into a plugin, although functionality remains the +same as with the previous version. Full documentation is in +L<Data::Compare::Plugins::Scalar::Properties>. + +=item Compiled regular expressions, eg qr/foo/ + +These are stringified before comparison, so the following will match: + + $r = qr/abc/i; + $s = qr/abc/i; + Compare($r, $s); + +and the following won't, despite them matching *exactly* the same text: + + $r = qr/abc/i; + $s = qr/[aA][bB][cC]/; + Compare($r, $s); + +Sorry, that's the best we can do. + +=item CODE and GLOB references + +These are assumed not to match unless the references are identical - ie, +both are references to the same thing. + +=back + +You may also customise how we compare structures by supplying options in +a hashref as a third parameter to the C<Compare()> function. This is not +yet available through the OO-ish interface. These options will be in +force for the *whole* of your comparison, so will apply to structures +that are lurking deep down in your data as well as at the top level, so +beware! + +=over 4 + +=item ignore_hash_keys + +an arrayref of strings. When comparing two hashes, any keys mentioned in +this list will be ignored. + +=back + +=head1 CIRCULAR STRUCTURES + +Comparing a circular structure to itself returns true: + + $x = \$y; + $y = \$x; + Compare([$x, $y], [$x, $y]); + +And on a sort-of-related note, if you try to compare insanely deeply nested +structures, the module will spit a warning. For this to affect you, you need to go +around a hundred levels deep though, and if you do that you have bigger +problems which I can't help you with ;-) + +=head1 PLUGINS + +The module takes plug-ins so you can provide specialised routines for +comparing your own objects and data-types. For details see +L<Data::Compare::Plugins>. + +Plugins are *not* available when running in "taint" mode. You may +also make it not load plugins by providing an empty list as the +argument to import() - ie, by doing this: + + use Data::Compare (); + +A couple of functions are provided to examine what goodies have been +made available through plugins: + +=over 4 + +=item plugins + +Returns a structure (a hash ref) describing all the comparisons made +available through plugins. +This function is *not* exported, so should be called as Data::Compare::plugins(). +It takes no parameters. + +=item plugins_printable + +Returns formatted text + +=back + +=head1 EXPORTS + +For historical reasons, the Compare() function is exported. If you +don't want this, then pass an empty list to import() as explained +under PLUGINS. If you want no export but do want plugins, then pass +the empty list, and then call the register_plugins class method: + + use Data::Compare (); + Data::Compare->register_plugins; + +or you could call it as a function if that floats your boat. + +=head1 SOURCE CODE REPOSITORY + +L<git://github.com/DrHyde/perl-modules-Data-Compare.git> + +=head1 BUGS + +Plugin support is not quite finished (see the TODO file for details) but +is usable. The missing bits are bells and whistles rather than core +functionality. + +Please report any other bugs either by email to David Cantrell (see below +for address) or using rt.cpan.org: + +L<https://rt.cpan.org/Ticket/Create.html?Queue=Data-Compare> + +=head1 AUTHOR + +Fabien Tassin E<lt>fta@sofaraway.orgE<gt> + +Portions by David Cantrell E<lt>david@cantrell.org.ukE<gt> + +=head1 COPYRIGHT and LICENCE + +Copyright (c) 1999-2001 Fabien Tassin. All rights reserved. +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +Some parts copyright 2003 - 2014 David Cantrell. + +Seeing that Fabien seems to have disappeared, David Cantrell has become +a co-maintainer so he can apply needed patches. The licence, of course, +remains the same. As the "perl licence" is "Artistic or GPL, your choice", +you can find them as the files ARTISTIC.txt and GPL2.txt in the +distribution. + +=head1 SEE ALSO + +L<Test::Deep::NoTest> + +perl(1), perlref(1) + +=cut diff --git a/lib/Data/Compare/Plugins.pod b/lib/Data/Compare/Plugins.pod new file mode 100644 index 0000000..97747fb --- /dev/null +++ b/lib/Data/Compare/Plugins.pod @@ -0,0 +1,101 @@ +=head1 NAME + +Data::Compare::Plugins - how to extend Data::Compare + +=head1 DESCRIPTION + +Data::Compare natively handles several built-in data types - scalars, +references to scalars, +references to arrays, references to hashes, references to +subroutines, compiled regular expressions, and globs. For objects, +it tries to Do The Right Thing and compares the underlying data type. +However, this is not always what you want. This is especially true if +you have complex objects which overload stringification and/or +numification. + +Hence we allow for plugins. + +=head1 FINDING PLUGINS + +Data::Compare will try to load any module installed on your system under +the various @INC/Data/Compare/Plugins/ directories. If there is a problem +loading any of them, an appropriate warning will be issued. + +Because of how we find plugins, no plugins are available when running in +"taint" mode. + +=head1 WRITING PLUGINS + +Internally, plugins are C<require>d into Data::Compare. This means that +they need to evaluate to true. We make use of that true value. Where +normally you just put: + + 1; + +at the end of an included file, you should instead ensure that you return +a reference to an array. This is treated as being true so satisfies perl, +and is a damned sight more useful. + +Inside that array should be either a description of what this plugin is to +do, or references to several arrays containing such descriptions. A +description consists of two or three items. First a string telling +us what the first data-type handled by your plugin is. Second, (and +optional, defaulting to the same as the first) the second data-type +to compare. To handle comparisons to ordinary scalars, give the empty string +for the data-type, ie: + + ['MyType', '', sub { ...}] + +Third and last, we need a reference to the +subroutine which does the comparison. +That subroutine should expect to take two parameters, which will be of +the specified type. It should return 1 if they compare +the same, or 0 if they compare different. + +Be aware that while you might give a description like: + + ['Type1', 'Type2', sub { ... }] + +this will handle both comparing Type1 to Type2, and comparing Type2 to +Type1. ie, comparison is commutative. + +If you want to use Data::Compare's own comparison function from within +your handler (to, for example, compare a data structure that you have +stored somewhere in your object) then you will need to call it as +Data::Compare::Compare. However, you must be careful to avoid infinite +recursion by calling D::C::Compare which in turn calls back to your +handler. + +The name of +your plugins does not matter, only that it lives in one of those directories. +Of course, giving it a sensible name means that the usual installation +mechanisms will put it in the right place, and meaningful names will make +it easier to debug your code. + +For an example, look at the plugin that handles Scalar::Properties +objects, which is distributed with Data::Compare. + +=head1 DISTRIBUTION + +Provided that the above rules are followed I see no reason for you to not +upload your plugin to the CPAN yourself. You will need to make Data::Compare +a pre-requisite, so that the CPAN.pm installer does the right thing. + +Alternatively, if you would prefer me to roll your plugin in with the +Data::Compare distribution, I'd be happy to do so provided that the code +is clear and well-commented, and that you include tests and documentation. + +=head1 SEE ALSO + +L<Data::Compare> + +L<Data::Compare::Plugins::Scalar::Properties> + +=head1 AUTHOR + +Copyright (c) 2004 David Cantrell <david@cantrell.org.uk>. +All rights reserved. +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=cut diff --git a/lib/Data/Compare/Plugins/Scalar/Properties.pm b/lib/Data/Compare/Plugins/Scalar/Properties.pm new file mode 100644 index 0000000..0c46b6b --- /dev/null +++ b/lib/Data/Compare/Plugins/Scalar/Properties.pm @@ -0,0 +1,94 @@ +package Data::Compare::Plugins::Scalar::Properties; + +use strict; +use vars qw($VERSION); +use Data::Compare; + +$VERSION = 1.0; + +sub register { + return [ + ['Scalar::Properties', \&sp_scalar_compare], + ['', 'Scalar::Properties', \&sp_scalar_compare], + ]; +} + +# note that when S::Ps are involved we can't use Data::Compare's default +# Compare function, so we use eq to check that values are the same. But +# we *do* use D::C::Compare whenever possible. + +# Compare a S::P and a scalar, or if we figure out that we've got two +# S::Ps, call sp_sp_compare instead + +sub sp_scalar_compare { + my($scalar, $sp) = @_; + + # we don't care what order the two params are, so swap if necessary + ($scalar, $sp) = ($sp, $scalar) if(ref($scalar)); + + # got two S::Ps? + return sp_sp_compare($scalar, $sp) if(ref($scalar)); + + # we've really got a scalar and an S::P, so just compare values + return 1 if($scalar eq $sp); + return 0; +} + +# Compare two S::Ps + +sub sp_sp_compare { + my($sp1, $sp2) = @_; + + # first check the values + return 0 unless($sp1 eq $sp2); + + # now check that we have all the same properties + return 0 unless(Data::Compare::Compare([sort $sp1->get_props()], [sort $sp2->get_props()])); + + # and that all properties have the same values + return 0 if( + grep { !Data::Compare::Compare(eval "\$sp1->$_()", eval "\$sp2->$_()") } $sp1->get_props() + ); + + # if we get here, all is tickety-boo + return 1; +} + +register(); + +=head1 NAME + +Data::Compare::Plugin::Scalar::Properties - plugin for Data::Compare to +handle Scalar::Properties objects. + +=head1 DESCRIPTION + +Enables Data::Compare to Do The Right Thing for Scalar::Properties +objects. + +=over 4 + +=item comparing a Scalar::Properties object and an ordinary scalar + +If you compare +a scalar and a Scalar::Properties, then they will be considered the same +if the two values are the same, regardless of the presence of properties. + +=item comparing two Scalar::Properties objects + +If you compare two Scalar::Properties objects, then they will only be +considered the same if the values and the properties match. + +=back + +=head1 AUTHOR + +Copyright (c) 2004 David Cantrell. All rights reserved. +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +L<Data::Compare> + +=cut diff --git a/t/FIXME-large-structures.t b/t/FIXME-large-structures.t new file mode 100644 index 0000000..077df4d --- /dev/null +++ b/t/FIXME-large-structures.t @@ -0,0 +1,421 @@ +use strict; +use warnings; +use Test::More tests => 1; + +use Data::Compare; +$SIG{ALRM} = sub { fail("timeout"); exit }; +alarm(5); + +TODO: { + local $TODO = "broken"; + ok(0); + # ok(Data::Compare::Compare(_get_data()), "yay, didn't timeout"); +} + +sub _get_data { +my $VAR1 = { +'bodies' => bless( { +'774e1dee53a6c80d99cca81f188abf91' => bless( { +'body' => 'Get Lost! +For the 2th time', +'headers' => bless( { +'340954c191bbbadfbd7ab37e62ac91c0' => bless( { +'body' => {}, +'header' => 'Re: Stuff', +'recipients' => bless( [ +bless( { +'To' => 'Billy 2', +'messages' => bless( { +'340954c191bbbadfbd7ab37e62ac91c0' => {} +}, 'Quarantine::RMessages' ) +}, 'Quarantine::Recipient' ) +], 'Quarantine::RList' ), +'sender' => bless( { +'From' => 'Jonny 1', +'messages' => bless( { +'0a763e41c9c22e1a97fcef68e37d2564' => bless( { +'body' => bless( { +'body' => 'Let me count the ways.... 3', +'headers' => bless( { +'0a763e41c9c22e1a97fcef68e37d2564' => {} +}, 'Quarantine::BHeaders' ) +}, 'Quarantine::Body' ), +'header' => 'Re: Stuff', +'recipients' => bless( [ +bless( { +'To' => 'Sally 3', +'messages' => bless( { +'0a763e41c9c22e1a97fcef68e37d2564' => {} +}, 'Quarantine::RMessages' ) +}, 'Quarantine::Recipient' ) +], 'Quarantine::RList' ), +'sender' => {}, +'uniq' => '0a763e41c9c22e1a97fcef68e37d2564' +}, 'Quarantine::Header' ), +'340954c191bbbadfbd7ab37e62ac91c0' => {}, +'655c7a5d8f36c58632a92e9c318fa9b4' => bless( { +'body' => {}, +'header' => 'Re: Stuff', +'recipients' => bless( [ +bless( { +'To' => 'Fred 2', +'messages' => bless( { +'655c7a5d8f36c58632a92e9c318fa9b4' => {} +}, 'Quarantine::RMessages' ) +}, 'Quarantine::Recipient' ) +], 'Quarantine::RList' ), +'sender' => {}, +'uniq' => '655c7a5d8f36c58632a92e9c318fa9b4' +}, 'Quarantine::Header' ), +'7020baa09e5801d94724257ee8fba3bc' => bless( { +'body' => bless( { +'body' => 'Get Lost! +For the 3th time', +'headers' => bless( { +'7020baa09e5801d94724257ee8fba3bc' => {}, +'ddd55caf8ac04ed3e75224cd12847bac' => bless( { +'body' => {}, +'header' => 'Re: Stuff', +'recipients' => bless( [ +bless( { +'To' => 'Billy 3', +'messages' => bless( { +'ddd55caf8ac04ed3e75224cd12847bac' => {} +}, 'Quarantine::RMessages' ) +}, 'Quarantine::Recipient' ) +], 'Quarantine::RList' ), +'sender' => {}, +'uniq' => 'ddd55caf8ac04ed3e75224cd12847bac' +}, 'Quarantine::Header' ) +}, 'Quarantine::BHeaders' ) +}, 'Quarantine::Body' ), +'header' => 'Re: Stuff', +'recipients' => bless( [ +bless( { +'To' => 'Fred 3', +'messages' => bless( { +'7020baa09e5801d94724257ee8fba3bc' => {} +}, 'Quarantine::RMessages' ) +}, 'Quarantine::Recipient' ) +], 'Quarantine::RList' ), +'sender' => {}, +'uniq' => '7020baa09e5801d94724257ee8fba3bc' +}, 'Quarantine::Header' ), +'bbed5198630e5d982f474ddb946b5cb6' => bless( { +'body' => bless( { +'body' => 'Let me count the ways.... 2', +'headers' => bless( { +'bbed5198630e5d982f474ddb946b5cb6' => {} +}, 'Quarantine::BHeaders' ) +}, 'Quarantine::Body' ), +'header' => 'Re: Stuff', +'recipients' => bless( [ +bless( { +'To' => 'Sally 2', +'messages' => bless( { +'bbed5198630e5d982f474ddb946b5cb6' => {} +}, 'Quarantine::RMessages' ) +}, 'Quarantine::Recipient' ) +], 'Quarantine::RList' ), +'sender' => {}, +'uniq' => 'bbed5198630e5d982f474ddb946b5cb6' +}, 'Quarantine::Header' ), +'ddd55caf8ac04ed3e75224cd12847bac' => {} +}, 'Quarantine::SMessages' ) +}, 'Quarantine::Sender' ), +'uniq' => '340954c191bbbadfbd7ab37e62ac91c0' +}, 'Quarantine::Header' ), +'655c7a5d8f36c58632a92e9c318fa9b4' => {} +}, 'Quarantine::BHeaders' ) +}, 'Quarantine::Body' ), +'81a987f71ec224975ad33bcd09e9ebe4' => {}, +'e3973a2585798a8e85f3a9a6a6ece156' => {}, +'f5794e56fc5ecd3a92a3586da3b6392a' => {} +}, 'Quarantine::Bodies' ), +'buckets' => bless( { +0 => bless( { +'a' => bless( { +'0a763e41c9c22e1a97fcef68e37d2564' => {} +}, 'Quarantine::Bucket2' ) +}, 'Quarantine::Bucket1' ), +3 => bless( { +4 => bless( { +'340954c191bbbadfbd7ab37e62ac91c0' => {} +}, 'Quarantine::Bucket2' ) +}, 'Quarantine::Bucket1' ), +6 => bless( { +5 => bless( { +'655c7a5d8f36c58632a92e9c318fa9b4' => {} +}, 'Quarantine::Bucket2' ) +}, 'Quarantine::Bucket1' ), +7 => bless( { +0 => bless( { +'7020baa09e5801d94724257ee8fba3bc' => {} +}, 'Quarantine::Bucket2' ) +}, 'Quarantine::Bucket1' ), +'b' => bless( { +'b' => bless( { +'bbed5198630e5d982f474ddb946b5cb6' => {} +}, 'Quarantine::Bucket2' ) +}, 'Quarantine::Bucket1' ), +'d' => bless( { +'d' => bless( { +'ddd55caf8ac04ed3e75224cd12847bac' => {} +}, 'Quarantine::Bucket2' ) +}, 'Quarantine::Bucket1' ) +}, 'Quarantine::Buckets' ), +'headers' => bless( {}, 'Quarantine::Headers' ), +'recipients' => bless( { +'Billy 2' => {}, +'Billy 3' => {}, +'Fred 2' => {}, +'Fred 3' => {}, +'Sally 2' => {}, +'Sally 3' => {} +}, 'Quarantine::Recipients' ), +'senders' => bless( { +'Jonny 1' => {} +}, 'Quarantine::Senders' ) +}; +$VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'body'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}; +$VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'recipients'}[0]{'messages'}{'340954c191bbbadfbd7ab37e62ac91c0'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}; +$VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'0a763e41c9c22e1a97fcef68e37d2564'}{'body'}{'headers'}{'0a763e41c9c22e1a97fcef68e37d2564'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'0a763e41c9c22e1a97fcef68e37d2564'}; +$VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'0a763e41c9c22e1a97fcef68e37d2564'}{'recipients'}[0]{'messages'}{'0a763e41c9c22e1a97fcef68e37d2564'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'0a763e41c9c22e1a97fcef68e37d2564'}; +$VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'0a763e41c9c22e1a97fcef68e37d2564'}{'sender'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}; +$VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'340954c191bbbadfbd7ab37e62ac91c0'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}; +$VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'655c7a5d8f36c58632a92e9c318fa9b4'}{'body'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}; +$VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'655c7a5d8f36c58632a92e9c318fa9b4'}{'recipients'}[0]{'messages'}{'655c7a5d8f36c58632a92e9c318fa9b4'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'655c7a5d8f36c58632a92e9c318fa9b4'}; +$VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'655c7a5d8f36c58632a92e9c318fa9b4'}{'sender'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}; +$VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}{'body'}{'headers'}{'7020baa09e5801d94724257ee8fba3bc'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}; +$VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}{'body'}{'headers'}{'ddd55caf8ac04ed3e75224cd12847bac'}{'body'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}{'body'}; +$VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}{'body'}{'headers'}{'ddd55caf8ac04ed3e75224cd12847bac'}{'recipients'}[0]{'messages'}{'ddd55caf8ac04ed3e75224cd12847bac'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}{'body'}{'headers'}{'ddd55caf8ac04ed3e75224cd12847bac'}; +$VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}{'body'}{'headers'}{'ddd55caf8ac04ed3e75224cd12847bac'}{'sender'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}; +$VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}{'recipients'}[0]{'messages'}{'7020baa09e5801d94724257ee8fba3bc'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}; +$VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}{'sender'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}; +$VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'bbed5198630e5d982f474ddb946b5cb6'}{'body'}{'headers'}{'bbed5198630e5d982f474ddb946b5cb6'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'bbed5198630e5d982f474ddb946b5cb6'}; +$VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'bbed5198630e5d982f474ddb946b5cb6'}{'recipients'}[0]{'messages'}{'bbed5198630e5d982f474ddb946b5cb6'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'bbed5198630e5d982f474ddb946b5cb6'}; +$VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'bbed5198630e5d982f474ddb946b5cb6'}{'sender'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}; +$VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'ddd55caf8ac04ed3e75224cd12847bac'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}{'body'}{'headers'}{'ddd55caf8ac04ed3e75224cd12847bac'}; +$VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'655c7a5d8f36c58632a92e9c318fa9b4'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'655c7a5d8f36c58632a92e9c318fa9b4'}; +$VAR1->{'bodies'}{'81a987f71ec224975ad33bcd09e9ebe4'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}{'body'}; +$VAR1->{'bodies'}{'e3973a2585798a8e85f3a9a6a6ece156'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'bbed5198630e5d982f474ddb946b5cb6'}{'body'}; +$VAR1->{'bodies'}{'f5794e56fc5ecd3a92a3586da3b6392a'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'0a763e41c9c22e1a97fcef68e37d2564'}{'body'}; +$VAR1->{'buckets'}{0}{'a'}{'0a763e41c9c22e1a97fcef68e37d2564'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'0a763e41c9c22e1a97fcef68e37d2564'}; +$VAR1->{'buckets'}{3}{4}{'340954c191bbbadfbd7ab37e62ac91c0'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}; +$VAR1->{'buckets'}{6}{5}{'655c7a5d8f36c58632a92e9c318fa9b4'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'655c7a5d8f36c58632a92e9c318fa9b4'}; +$VAR1->{'buckets'}{7}{0}{'7020baa09e5801d94724257ee8fba3bc'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}; +$VAR1->{'buckets'}{'b'}{'b'}{'bbed5198630e5d982f474ddb946b5cb6'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'bbed5198630e5d982f474ddb946b5cb6'}; +$VAR1->{'buckets'}{'d'}{'d'}{'ddd55caf8ac04ed3e75224cd12847bac'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}{'body'}{'headers'}{'ddd55caf8ac04ed3e75224cd12847bac'}; +$VAR1->{'recipients'}{'Billy 2'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'recipients'}[0]; +$VAR1->{'recipients'}{'Billy 3'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}{'body'}{'headers'}{'ddd55caf8ac04ed3e75224cd12847bac'}{'recipients'}[0]; +$VAR1->{'recipients'}{'Fred 2'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'655c7a5d8f36c58632a92e9c318fa9b4'}{'recipients'}[0]; +$VAR1->{'recipients'}{'Fred 3'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}{'recipients'}[0]; +$VAR1->{'recipients'}{'Sally 2'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'bbed5198630e5d982f474ddb946b5cb6'}{'recipients'}[0]; +$VAR1->{'recipients'}{'Sally 3'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'0a763e41c9c22e1a97fcef68e37d2564'}{'recipients'}[0]; +$VAR1->{'senders'}{'Jonny 1'} = $VAR1->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}; + + +my $VAR2 = { +'bodies' => bless( { +'774e1dee53a6c80d99cca81f188abf91' => bless( { +'body' => 'Get Lost! +For the 2th time', +'headers' => bless( { +'340954c191bbbadfbd7ab37e62ac91c0' => bless( { +'body' => {}, +'header' => 'Re: Stuff', +'recipients' => bless( [ +bless( { +'To' => 'Billy 2', +'messages' => bless( { +'340954c191bbbadfbd7ab37e62ac91c0' => {} +}, 'Quarantine::RMessages' ) +}, 'Quarantine::Recipient' ) +], 'Quarantine::RList' ), +'sender' => bless( { +'From' => 'Jonny 1', +'messages' => bless( { +'0a763e41c9c22e1a97fcef68e37d2564' => bless( { +'body' => bless( { +'body' => 'Let me count the ways.... 3', +'headers' => bless( { +'0a763e41c9c22e1a97fcef68e37d2564' => {} +}, 'Quarantine::BHeaders' ) +}, 'Quarantine::Body' ), +'header' => 'Re: Stuff', +'recipients' => bless( [ +bless( { +'To' => 'Sally 3', +'messages' => bless( { +'0a763e41c9c22e1a97fcef68e37d2564' => {} +}, 'Quarantine::RMessages' ) +}, 'Quarantine::Recipient' ) +], 'Quarantine::RList' ), +'sender' => {}, +'uniq' => '0a763e41c9c22e1a97fcef68e37d2564' +}, 'Quarantine::Header' ), +'340954c191bbbadfbd7ab37e62ac91c0' => {}, +'655c7a5d8f36c58632a92e9c318fa9b4' => bless( { +'body' => {}, +'header' => 'Re: Stuff', +'recipients' => bless( [ +bless( { +'To' => 'Fred 2', +'messages' => bless( { +'655c7a5d8f36c58632a92e9c318fa9b4' => {} +}, 'Quarantine::RMessages' ) +}, 'Quarantine::Recipient' ) +], 'Quarantine::RList' ), +'sender' => {}, +'uniq' => '655c7a5d8f36c58632a92e9c318fa9b4' +}, 'Quarantine::Header' ), +'7020baa09e5801d94724257ee8fba3bc' => bless( { +'body' => bless( { +'body' => 'Get Lost! +For the 3th time', +'headers' => bless( { +'7020baa09e5801d94724257ee8fba3bc' => {}, +'ddd55caf8ac04ed3e75224cd12847bac' => bless( { +'body' => {}, +'header' => 'Re: Stuff', +'recipients' => bless( [ +bless( { +'To' => 'Billy 3', +'messages' => bless( { +'ddd55caf8ac04ed3e75224cd12847bac' => {} +}, 'Quarantine::RMessages' ) +}, 'Quarantine::Recipient' ) +], 'Quarantine::RList' ), +'sender' => {}, +'uniq' => 'ddd55caf8ac04ed3e75224cd12847bac' +}, 'Quarantine::Header' ) +}, 'Quarantine::BHeaders' ) +}, 'Quarantine::Body' ), +'header' => 'Re: Stuff', +'recipients' => bless( [ +bless( { +'To' => 'Fred 3', +'messages' => bless( { +'7020baa09e5801d94724257ee8fba3bc' => {} +}, 'Quarantine::RMessages' ) +}, 'Quarantine::Recipient' ) +], 'Quarantine::RList' ), +'sender' => {}, +'uniq' => '7020baa09e5801d94724257ee8fba3bc' +}, 'Quarantine::Header' ), +'bbed5198630e5d982f474ddb946b5cb6' => bless( { +'body' => bless( { +'body' => 'Let me count the ways.... 2', +'headers' => bless( { +'bbed5198630e5d982f474ddb946b5cb6' => {} +}, 'Quarantine::BHeaders' ) +}, 'Quarantine::Body' ), +'header' => 'Re: Stuff', +'recipients' => bless( [ +bless( { +'To' => 'Sally 2', +'messages' => bless( { +'bbed5198630e5d982f474ddb946b5cb6' => {} +}, 'Quarantine::RMessages' ) +}, 'Quarantine::Recipient' ) +], 'Quarantine::RList' ), +'sender' => {}, +'uniq' => 'bbed5198630e5d982f474ddb946b5cb6' +}, 'Quarantine::Header' ), +'ddd55caf8ac04ed3e75224cd12847bac' => {} +}, 'Quarantine::SMessages' ) +}, 'Quarantine::Sender' ), +'uniq' => '340954c191bbbadfbd7ab37e62ac91c0' +}, 'Quarantine::Header' ), +'655c7a5d8f36c58632a92e9c318fa9b4' => {} +}, 'Quarantine::BHeaders' ) +}, 'Quarantine::Body' ), +'81a987f71ec224975ad33bcd09e9ebe4' => {}, +'e3973a2585798a8e85f3a9a6a6ece156' => {}, +'f5794e56fc5ecd3a92a3586da3b6392a' => {} +}, 'Quarantine::Bodies' ), +'buckets' => bless( { +0 => bless( { +'a' => bless( { +'0a763e41c9c22e1a97fcef68e37d2564' => {} +}, 'Quarantine::Bucket2' ) +}, 'Quarantine::Bucket1' ), +3 => bless( { +4 => bless( { +'340954c191bbbadfbd7ab37e62ac91c0' => {} +}, 'Quarantine::Bucket2' ) +}, 'Quarantine::Bucket1' ), +6 => bless( { +5 => bless( { +'655c7a5d8f36c58632a92e9c318fa9b4' => {} +}, 'Quarantine::Bucket2' ) +}, 'Quarantine::Bucket1' ), +7 => bless( { +0 => bless( { +'7020baa09e5801d94724257ee8fba3bc' => {} +}, 'Quarantine::Bucket2' ) +}, 'Quarantine::Bucket1' ), +'b' => bless( { +'b' => bless( { +'bbed5198630e5d982f474ddb946b5cb6' => {} +}, 'Quarantine::Bucket2' ) +}, 'Quarantine::Bucket1' ), +'d' => bless( { +'d' => bless( { +'ddd55caf8ac04ed3e75224cd12847bac' => {} +}, 'Quarantine::Bucket2' ) +}, 'Quarantine::Bucket1' ) +}, 'Quarantine::Buckets' ), +'headers' => bless( {}, 'Quarantine::Headers' ), +'recipients' => bless( { +'Billy 2' => {}, +'Billy 3' => {}, +'Fred 2' => {}, +'Fred 3' => {}, +'Sally 2' => {}, +'Sally 3' => {} +}, 'Quarantine::Recipients' ), +'senders' => bless( { +'Jonny 1' => {} +}, 'Quarantine::Senders' ) +}; +$VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'body'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}; +$VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'recipients'}[0]{'messages'}{'340954c191bbbadfbd7ab37e62ac91c0'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}; +$VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'0a763e41c9c22e1a97fcef68e37d2564'}{'body'}{'headers'}{'0a763e41c9c22e1a97fcef68e37d2564'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'0a763e41c9c22e1a97fcef68e37d2564'}; +$VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'0a763e41c9c22e1a97fcef68e37d2564'}{'recipients'}[0]{'messages'}{'0a763e41c9c22e1a97fcef68e37d2564'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'0a763e41c9c22e1a97fcef68e37d2564'}; +$VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'0a763e41c9c22e1a97fcef68e37d2564'}{'sender'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}; +$VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'340954c191bbbadfbd7ab37e62ac91c0'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}; +$VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'655c7a5d8f36c58632a92e9c318fa9b4'}{'body'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}; +$VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'655c7a5d8f36c58632a92e9c318fa9b4'}{'recipients'}[0]{'messages'}{'655c7a5d8f36c58632a92e9c318fa9b4'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'655c7a5d8f36c58632a92e9c318fa9b4'}; +$VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'655c7a5d8f36c58632a92e9c318fa9b4'}{'sender'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}; +$VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}{'body'}{'headers'}{'7020baa09e5801d94724257ee8fba3bc'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}; +$VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}{'body'}{'headers'}{'ddd55caf8ac04ed3e75224cd12847bac'}{'body'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}{'body'}; +$VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}{'body'}{'headers'}{'ddd55caf8ac04ed3e75224cd12847bac'}{'recipients'}[0]{'messages'}{'ddd55caf8ac04ed3e75224cd12847bac'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}{'body'}{'headers'}{'ddd55caf8ac04ed3e75224cd12847bac'}; +$VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}{'body'}{'headers'}{'ddd55caf8ac04ed3e75224cd12847bac'}{'sender'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}; +$VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}{'recipients'}[0]{'messages'}{'7020baa09e5801d94724257ee8fba3bc'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}; +$VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}{'sender'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}; +$VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'bbed5198630e5d982f474ddb946b5cb6'}{'body'}{'headers'}{'bbed5198630e5d982f474ddb946b5cb6'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'bbed5198630e5d982f474ddb946b5cb6'}; +$VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'bbed5198630e5d982f474ddb946b5cb6'}{'recipients'}[0]{'messages'}{'bbed5198630e5d982f474ddb946b5cb6'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'bbed5198630e5d982f474ddb946b5cb6'}; +$VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'bbed5198630e5d982f474ddb946b5cb6'}{'sender'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}; +$VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'ddd55caf8ac04ed3e75224cd12847bac'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}{'body'}{'headers'}{'ddd55caf8ac04ed3e75224cd12847bac'}; +$VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'655c7a5d8f36c58632a92e9c318fa9b4'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'655c7a5d8f36c58632a92e9c318fa9b4'}; +$VAR2->{'bodies'}{'81a987f71ec224975ad33bcd09e9ebe4'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}{'body'}; +$VAR2->{'bodies'}{'e3973a2585798a8e85f3a9a6a6ece156'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'bbed5198630e5d982f474ddb946b5cb6'}{'body'}; +$VAR2->{'bodies'}{'f5794e56fc5ecd3a92a3586da3b6392a'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'0a763e41c9c22e1a97fcef68e37d2564'}{'body'}; +$VAR2->{'buckets'}{0}{'a'}{'0a763e41c9c22e1a97fcef68e37d2564'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'0a763e41c9c22e1a97fcef68e37d2564'}; +$VAR2->{'buckets'}{3}{4}{'340954c191bbbadfbd7ab37e62ac91c0'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}; +$VAR2->{'buckets'}{6}{5}{'655c7a5d8f36c58632a92e9c318fa9b4'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'655c7a5d8f36c58632a92e9c318fa9b4'}; +$VAR2->{'buckets'}{7}{0}{'7020baa09e5801d94724257ee8fba3bc'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}; +$VAR2->{'buckets'}{'b'}{'b'}{'bbed5198630e5d982f474ddb946b5cb6'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'bbed5198630e5d982f474ddb946b5cb6'}; +$VAR2->{'buckets'}{'d'}{'d'}{'ddd55caf8ac04ed3e75224cd12847bac'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}{'body'}{'headers'}{'ddd55caf8ac04ed3e75224cd12847bac'}; +$VAR2->{'recipients'}{'Billy 2'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'recipients'}[0]; +$VAR2->{'recipients'}{'Billy 3'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}{'body'}{'headers'}{'ddd55caf8ac04ed3e75224cd12847bac'}{'recipients'}[0]; +$VAR2->{'recipients'}{'Fred 2'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'655c7a5d8f36c58632a92e9c318fa9b4'}{'recipients'}[0]; +$VAR2->{'recipients'}{'Fred 3'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'7020baa09e5801d94724257ee8fba3bc'}{'recipients'}[0]; +$VAR2->{'recipients'}{'Sally 2'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'bbed5198630e5d982f474ddb946b5cb6'}{'recipients'}[0]; +$VAR2->{'recipients'}{'Sally 3'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}{'messages'}{'0a763e41c9c22e1a97fcef68e37d2564'}{'recipients'}[0]; +$VAR2->{'senders'}{'Jonny 1'} = $VAR2->{'bodies'}{'774e1dee53a6c80d99cca81f188abf91'}{'headers'}{'340954c191bbbadfbd7ab37e62ac91c0'}{'sender'}; + +return ($VAR1, $VAR2); +} + diff --git a/t/compare.t b/t/compare.t new file mode 100644 index 0000000..94a6732 --- /dev/null +++ b/t/compare.t @@ -0,0 +1,164 @@ +# -*- Mode: Perl -*- + +BEGIN { unshift @INC, "lib", "../lib" } +use strict; +use warnings; +# use diagnostics; + +use Data::Compare; + +local $^W = 1; +print "1..45\n"; + +my $t = 1; + +my $s0 = undef; +my $s1 = 0; +my $s2 = 10; + +# 1 .. 4 +&comp($s0, $s0, 1); +&comp($s1, $s1, 1); +&comp($s2, $s2, 1); +&comp($s0, $s1, 0); + +my $s3 = \$s2; +my $s4 = \$s1; +my $s5 = "$s4"; +my $s6 = 0; +my $s7 = \$s6; + +# 5 .. 8 +&comp($s3, $s3, 1); +&comp($s3, $s4, 0); +&comp($s4, $s5, 0); +&comp($s4, $s7, 1); + +my $a1 = []; +my $a2 = [ 0 ]; +my $a3 = [ '' ]; +my $a4 = [ 1, 2, 3 ]; +my $a5 = [ 1, 2, 4 ]; +my $a6 = [ 1, 2, 3, 5 ]; + +# 9 .. 13 +&comp($a1, $a1, 1); +&comp($a1, $a2, 0); +&comp($a2, $a3, 0); +&comp($a4, $a5, 0); +&comp($a4, $a6, 0); + +my $h1 = {}; +my $h2 = { 'foo' => 'bar' }; +my $h3 = { 'foo' => 'bar' }; +my $h4 = { 'foo' => 'bar', 'bar' => 'foo' }; + +# 14 .. 19 +&comp($h1, $s0, 0); +&comp($h1, $h1, 1); +&comp($h2, $h2, 1); +&comp($h2, $h3, 1); +&comp($h1, $h2, 0); +&comp($h3, $h4, 0); + +my $o1 = bless [ 'FOO', 'BAR' ], 'foo'; +my $o2 = bless [ 'FOO', 'BAR' ], 'foo'; +my $o3 = bless [ 'FOO', 'BAR' ], 'fool'; +my $o4 = bless [ 'FOO', 'BAR', 'BAZ' ], 'foo'; + +# 20 .. 22 +&comp($o1, $o2, 1); +&comp($o1, $o3, 0); +&comp($o1, $o4, 0); + +my $o5 = bless { 'FOO' => 'BAR' }, 'foo'; +my $o6 = bless { 'FOO' => 'BAR' }, 'foo'; +my $o7 = bless { 'FOO' => 'BAR' }, 'fool'; +my $o8 = bless { 'FOO' => 'BAR', 'foo' => 'BAZ' }, 'foo'; + +# 23 .. 25 +&comp($o5, $o6, 1); +&comp($o5, $o7, 0); +&comp($o5, $o8, 0); + +my $s8 = 0; +my $o9 = bless \$s0, 'foo'; +my $o10 = bless \$s8, 'foo'; +my $o11 = bless \$s1, 'foo'; + +# 26 .. 27 +&comp($o9, $o10, 0); +&comp($o10, $o11, 1); + +my $g1 = \*STDIN; +my $g2 = \*STDOUT; + +# 28 .. 29 +&comp($g1, $g1, 1); +&comp($g1, $g2, 0); + +my $o12 = bless $g1, 'foo'; +my $o13 = bless $g2, 'foo'; + +# 30 .. 31 +&comp($o12, $o12, 1); +&comp($o12, $o13, 0); + +my $o16 = bless sub { print "foo\n" }, 'foo'; +my $o17 = bless sub { print "foo\n" }, 'foo'; + +# 32 +&comp($o16, $o17, 0); # :( + +my $v1 = { 'foo' => [ 1, { 'bar' => 'baz' }, 3 ] }; +my $v2 = { 'bar' => 'baz' }; +my $v3 = [ 1, $v2, 3 ]; +my $v4 = { 'foo' => $v3 }; + +# 33 +&comp($v1, $v4, 1); + +# 34 .. 37 +&comp(\\1, \\1, 1); +&comp(\\1, \\2, 0); +&comp(\\1, 1, 0); +&comp(\\1, \1, 0); + +# 38 .. 40 +&comp(qr/abc/i, qr/abc/i, 1, "Identical regexen"); +&comp(qr/abc/i, qr/[aA][bB][cC]/, 0, "Non-identical regexen"); +&comp(qr/abc/i, '(?i-xsm:abc)', 0, "Regex and scalar which stringify the same"); + +# 41 .. 43 +# scalar cross +$a = []; +my($x, $y); +$x=\$y; +$y=\$x; +$a->[0]=\$a->[1]; +$a->[1]=\$a->[0]; +&comp([$x, $y], $a, 1, "two parallel circular structures compare the same"); + +# these two are probably superfluous, as they test referential equality +# rather than any of the stuff we added to do with circles and recursion +&comp([$x, $y], [$y, $x], 1, "looking at a circle from two different starting points compares the same"); +&comp([$x, $y], [$x, $y], 1, "a circular structure compares to itself"); + +$a = []; +$b = []; +$a->[0] = { foo => { bar => $a } }; +$b->[0] = { foo => { bar => $b } }; +$a->[1] = $b->[1] = 5; +comp($a, $b, 1, "structure of a circle plus same data compares the same"); + +$a->[1] = 6; +comp($a, $b, 0, "structure of a circle plus different data compares different"); +sub comp { + my $a = shift; + my $b = shift; + my $expect = shift; + my $comment = shift; + + print Compare ($a, $b) == $expect ? "" : "not ", "ok ", $t++, + ($comment) ? " $comment\n" : "\n"; +} diff --git a/t/coverage.sh b/t/coverage.sh new file mode 100755 index 0000000..7b334b1 --- /dev/null +++ b/t/coverage.sh @@ -0,0 +1,5 @@ +#!/bin/sh + +cover -delete +HARNESS_PERL_SWITCHES=-MDevel::Cover=-coverage,statement,branch,condition,path,subroutine make test +cover diff --git a/t/deep-objects.t b/t/deep-objects.t new file mode 100644 index 0000000..a2c9702 --- /dev/null +++ b/t/deep-objects.t @@ -0,0 +1,28 @@ +#!/usr/bin/perl -w + +use strict; +use warnings; +# use diagnostics; + +eval 'use Clone'; +($@) ? + do { + print "1..0 # Skipping no Clone found\n"; + exit(0); + } : + eval 'use Test::More tests => 1;'; + +use Data::Compare; + +my $c = bless { foo => 1 }, 'Foo'; +my $d = bless { c => $c }, "Foo::D"; +my $e = bless { d => $d }, "Foo::E"; +my $f = bless { e => $e }, "Foo::F"; +my $g = bless { f => $f }, "Foo::G"; +my $h = bless { g => $g }, "Foo::H"; +my $i = bless { h => $h }, "Foo::I"; +my $j = bless { i => $i }, "Foo::J"; +my $k = Clone::clone $j; + +Compare($j, $k); +ok(Compare($j, $k), 'Can compare deeply-nested objecty jibber-jabber'); diff --git a/t/deep-recursion.t b/t/deep-recursion.t new file mode 100644 index 0000000..9861c0a --- /dev/null +++ b/t/deep-recursion.t @@ -0,0 +1,34 @@ +#!/usr/bin/perl -w + +use strict; +use warnings; +# use diagnostics; + +use Data::Compare; +use Test::More tests => 3; + +my $warning= ''; +$SIG{__WARN__} = sub { $warning= shift; }; + +my($data1, $data2) = ({}, {}); +foreach my $i (qw(a b c d e f g h i j)) { + foreach my $j (qw(k l m n o p q r s t)) { + $data1->{$i}->{$j} = 'i like pie'; + $data2->{$i}->{$j} = 'i like pie'; + } +} + +# check that we DTRT on very deep recursion +$a = [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[0]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]; +$b = [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[0]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]; +Compare($a, $b); +ok($warning, "warn on deep recursion"); +$warning = ''; + +Compare([5], [5]) foreach(1..1000); +ok(!$warning, "recursion counter correctly reset"); + + +Compare($data1, $data2); + +ok(!$warning, "no warnings emitted on large flat structures"); diff --git a/t/duplicates.t b/t/duplicates.t new file mode 100644 index 0000000..e2636fb --- /dev/null +++ b/t/duplicates.t @@ -0,0 +1,16 @@ +#!/usr/bin/perl -w + +use strict; +use warnings; +# use diagnostics; + +use Test::More tests => 2; + +use Data::Compare; + +my $z = 0; +ok(Compare([\$z, \$z], [\$z, \$z]), 'Can compare duplicated array data'); +ok(Compare( + { a => \$z, b => \$z }, + { a => \$z, b => \$z } +), 'Can compare duplicated hash data'); diff --git a/t/lib/SpecialClass.pm b/t/lib/SpecialClass.pm new file mode 100644 index 0000000..9dbb3e9 --- /dev/null +++ b/t/lib/SpecialClass.pm @@ -0,0 +1,12 @@ +package SpecialClass; +use strict;use warnings; +use overload + '""' => \&to_string, + '0+' => \&to_number, + fallback=>1; + +sub new { my ($class,%data) = @_; bless {%data},$class } +sub to_string { return $_[0]->{str} || 'foo' } +sub to_number { return $_[0]->{num} || 12 } + +1; diff --git a/t/noimport-register_plugins.t b/t/noimport-register_plugins.t new file mode 100644 index 0000000..de2c669 --- /dev/null +++ b/t/noimport-register_plugins.t @@ -0,0 +1,13 @@ +#!perl -w + +use Data::Compare (); +Data::Compare->register_plugins(); + +print "1..1\n"; + +my $test = 0; + +# and now there should be plugins + +print "not " if(Data::Compare::Compare({}, Data::Compare::plugins())); +print 'ok '.(++$test)." plugins available in no-import mode if explicitly asked for\n"; diff --git a/t/noimport.t b/t/noimport.t new file mode 100644 index 0000000..f752e11 --- /dev/null +++ b/t/noimport.t @@ -0,0 +1,11 @@ +#!perl -w + +use Data::Compare (); +print "1..1\n"; + +my $test = 0; + +# in no-import mode there should be no plugins + +print "not " unless(Data::Compare::Compare({}, Data::Compare::plugins())); +print 'ok '.(++$test)." plugins disabled in no-import mode\n"; @@ -0,0 +1,27 @@ +# -*- Mode: Perl -*- + +BEGIN { unshift @INC, "lib", "../lib" } +use strict; +use Data::Compare; + +local $^W = 1; +print "1..7\n"; + +my $t = 1; + +my $a = { 'foo' => [ 'bar', 'baz' ] }; +my $b = { 'Foo' => [ 'bar', 'baz' ] }; + +my $c = new Data::Compare ($a, $b); +print !$c->Cmp ? "" : "not ", "ok ", $t++, "\n"; +print $c->Cmp($a, $a) ? "" : "not ", "ok ", $t++, "\n"; +print !$c->Cmp($a, $b) ? "" : "not ", "ok ", $t++, "\n"; + +my $d = new Data::Compare; +print $d->Cmp ? "" : "not ", "ok ", $t++, "\n"; +print $d->Cmp($a, $a) ? "" : "not ", "ok ", $t++, "\n"; +print !$d->Cmp($a, $b) ? "" : "not ", "ok ", $t++, "\n"; + +my $e = new Data::Compare; + +print $d->Cmp ($d, $e) ? "" : "not ", "ok ", $t++, "\n"; diff --git a/t/opts-ignore-hash-keys.t b/t/opts-ignore-hash-keys.t new file mode 100644 index 0000000..c5fdd27 --- /dev/null +++ b/t/opts-ignore-hash-keys.t @@ -0,0 +1,38 @@ +# -*- Mode: Perl -*- + +BEGIN { unshift @INC, "lib", "../lib" } +use strict; +use Data::Compare; + +local $^W = 1; +print "1..4\n"; + +my $test = 0; + +print 'not ' unless(Compare( + { foo => 'FOO', bar => 'BAR', baz => 'BAZ' }, + { foo => 'FOO', bar => 'BAR' }, + { ignore_hash_keys => [qw(baz)] } +) == 1); +print 'ok '.(++$test)." different hashes compare the same when ignoring extra key in first\n"; + +print 'not ' unless(Compare( + { foo => 'FOO', bar => 'BAR' }, + { foo => 'FOO', bar => 'BAR', baz => 'BAZ' }, + { ignore_hash_keys => [qw(baz)] } +) == 1); +print 'ok '.(++$test)." different hashes compare the same when ignoring extra key in second\n"; + +print 'not ' unless(Compare( + { foo => 'FOO', bar => 'BAR', baz => [] }, + { foo => 'FOO', bar => 'BAR', baz => 'BAZ' }, + { ignore_hash_keys => [qw(baz)] } +) == 1); +print 'ok '.(++$test)." ignoring a key that differs works\n"; + +print 'not ' unless(Compare( + { foo => 'FOO', bar => 'BAR', baz => [] }, + { foo => 'FOO', bar => 'BAR', baz => 'BAZ' }, + { ignore_hash_keys => [qw(bar)] } +) == 0); +print 'ok '.(++$test)." ignoring equal data in differing hashes compares unequal\n"; diff --git a/t/overload.t b/t/overload.t new file mode 100644 index 0000000..1fdbb97 --- /dev/null +++ b/t/overload.t @@ -0,0 +1,15 @@ +use strict; +use warnings; +use lib 't/lib'; +use SpecialClass; + +use Data::Compare; +use Test::More tests=>2; + +ok(!Compare(SpecialClass->new(str=>'bar'), + SpecialClass->new(str=>'bar',num=>15)), + 'String overload does not fool it'); + +ok(!Compare(SpecialClass->new(str=>'bar',num=>15), + SpecialClass->new(str=>'boo',num=>15)), + 'Numeric overload does not fool it'); diff --git a/t/plugins.t b/t/plugins.t new file mode 100644 index 0000000..828ad5c --- /dev/null +++ b/t/plugins.t @@ -0,0 +1,23 @@ +#!perl -w + +use strict; + +use Data::Compare; + +print "1..1\n"; + +my $test = 0; + +# Scalar::Properties is the only plugin we know will be present. The plugin +# will even be present if S::P itself isn't installed. +my $plugins = Data::Compare::plugins(); +my %pairs = (); +foreach my $key (keys %{$plugins}) { + foreach(@{$plugins->{$key}}) { + $pairs{"$key <-> $_"} = 1; + $pairs{"$_ <-> $key"} = 1 if($key ne $_); + } +} + +print 'not ' unless($pairs{'[scalar] <-> Scalar::Properties'} && $pairs{'Scalar::Properties <-> Scalar::Properties'} && $pairs{'Scalar::Properties <-> [scalar]'}); +print 'ok '.(++$test)." plugins() function\n"; @@ -0,0 +1,9 @@ +# $Id: pod.t,v 1.1 2007/07/30 12:49:38 drhyde Exp $ +use strict; + +$^W=1; + +use Test::More; +eval "use Test::Pod 1.00"; +plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; +all_pod_files_ok(); diff --git a/t/realtainttest b/t/realtainttest new file mode 100644 index 0000000..a972bc7 --- /dev/null +++ b/t/realtainttest @@ -0,0 +1,11 @@ +use strict; + +use Data::Compare; +print "1..1\n"; + +my $test = 0; + +# in taint mode there should be no plugins + +print "not " unless(Compare({}, Data::Compare::plugins())); +print 'ok '.(++$test)." plugins disabled in taint mode\n"; diff --git a/t/saritha-nalagandla-bug.t b/t/saritha-nalagandla-bug.t new file mode 100644 index 0000000..5f70432 --- /dev/null +++ b/t/saritha-nalagandla-bug.t @@ -0,0 +1,34 @@ +#!perl -w
+# $Id: saritha-nalagandla-bug.t,v 1.2 2008/08/26 20:51:36 drhyde Exp $
+
+use strict;
+use Data::Compare;
+eval "use JSON";
+if($@) {
+ eval 'use Test::More skip_all => "no JSON support";exit 0';
+} elsif($JSON::VERSION < 2.9) {
+ eval 'use Test::More skip_all => "JSON module too old";exit 0';
+} else {
+ eval 'use Test::More tests => 2';
+}
+
+my $expfile = "t/saritha-nalagandla-bug/test082_updateevent_multipleinvitees.exp";
+my $outfile = "t/saritha-nalagandla-bug/test082_updateevent_multipleinvitees.out";
+my $ignoreKeysList = [qw(UID INVID LAST_MODIFIED DTSTAMP_UTC BUILD)];
+
+$/ = undef;
+
+($expfile, $outfile) = map {
+ open(FILE, $_) || die("Can't open $_\n");
+ my $f = <FILE>;
+ close(FILE);
+ from_json($f);
+} ($expfile, $outfile);
+
+# delete $expfile->{RESPONSE}{VALUE}{ATTENDEE}[0]{RSVP};
+# delete $outfile->{RESPONSE}{VALUE}{ATTENDEE}[0]{RSVP};
+# delete $expfile->{RESPONSE}{VALUE}{ATTENDEE}[1]{RSVP};
+# delete $outfile->{RESPONSE}{VALUE}{ATTENDEE}[1]{RSVP};
+
+ok(Compare($expfile, $outfile, {ignore_hash_keys=> $ignoreKeysList}), "match with ignore_hash_keys");
+ok(!Compare($expfile, $outfile), "doesn't match without ignore_hash_keys");
diff --git a/t/saritha-nalagandla-bug/test082_updateevent_multipleinvitees.exp b/t/saritha-nalagandla-bug/test082_updateevent_multipleinvitees.exp new file mode 100644 index 0000000..48e591c --- /dev/null +++ b/t/saritha-nalagandla-bug/test082_updateevent_multipleinvitees.exp @@ -0,0 +1,51 @@ +{ + "REQUEST" : { + "BUILD" : "5.0 hitaine 20080801-1615", + "DTSTAMP_UTC" : "20080804T122520", + "INTL" : "us", + "OPERATION" : "UPDATE_EVENT", + "SERVICE" : "CAL", + "SERVICE_VERSION" : "1.2", + "USER" : "autocaljson3" + }, + "RESPONSE" : { + "CODE" : 0, + "VALUE" : { + "ACCOUNT_ID" : "autocaljson3", + "ALL_DAY" : false, + "ATTENDEE" : [ + { + "EMAIL" : "f323_bart1@yahoo.com", + "PARTSTAT" : "ACCEPTED", + "RSVP" : false + }, + { + "EMAIL" : "f323_bart2@yahoo.com", + "PARTSTAT" : "DECLINED", + "RSVP" : false + } + ], + "CLASS" : "PUBLIC", + "COMMENT" : [ + "test comment" + ], + "COMPONENT_TYPE" : "EVENT", + "DESCRIPTION" : "go party", + "DTEND" : "20080820T093000", + "DTEND_TZID" : "America/Los_Angeles", + "DTSTART" : "20080820T090000", + "DTSTART_TZID" : "America/Los_Angeles", + "DURATION" : "PT30M", + "FOLDER_ID" : 131, + "INVID" : "1092-1091", + "LAST_MODIFIED" : "20080804T122520", + "LOCATION" : "test loc", + "ORGANIZER" : "autocaljson3@yahoo.com", + "STATUS" : "CONFIRMED", + "SUMMARY" : "Party Update event 082", + "TRANSP" : "OPAQUE", + "TYPE" : 10, + "UID" : "c3e0efde-da42-45dc-8322-46ff686a5832" + } + } +}
\ No newline at end of file diff --git a/t/saritha-nalagandla-bug/test082_updateevent_multipleinvitees.out b/t/saritha-nalagandla-bug/test082_updateevent_multipleinvitees.out new file mode 100644 index 0000000..92d45b4 --- /dev/null +++ b/t/saritha-nalagandla-bug/test082_updateevent_multipleinvitees.out @@ -0,0 +1,51 @@ +{ + "REQUEST" : { + "BUILD" : "5.0 akanjila 20080806-1047", + "DTSTAMP_UTC" : "20080807T001048", + "INTL" : "us", + "OPERATION" : "UPDATE_EVENT", + "SERVICE" : "CAL", + "SERVICE_VERSION" : "1.2", + "USER" : "autocaljson3" + }, + "RESPONSE" : { + "CODE" : 0, + "VALUE" : { + "ACCOUNT_ID" : "autocaljson3", + "ALL_DAY" : false, + "ATTENDEE" : [ + { + "EMAIL" : "f323_bart1@yahoo.com", + "PARTSTAT" : "ACCEPTED", + "RSVP" : false + }, + { + "EMAIL" : "f323_bart2@yahoo.com", + "PARTSTAT" : "DECLINED", + "RSVP" : false + } + ], + "CLASS" : "PUBLIC", + "COMMENT" : [ + "test comment" + ], + "COMPONENT_TYPE" : "EVENT", + "DESCRIPTION" : "go party", + "DTEND" : "20080820T093000", + "DTEND_TZID" : "America/Los_Angeles", + "DTSTART" : "20080820T090000", + "DTSTART_TZID" : "America/Los_Angeles", + "DURATION" : "PT30M", + "FOLDER_ID" : 131, + "INVID" : "331-330", + "LAST_MODIFIED" : "20080807T001048", + "LOCATION" : "test loc", + "ORGANIZER" : "autocaljson3@yahoo.com", + "STATUS" : "CONFIRMED", + "SUMMARY" : "Party Update event 082", + "TRANSP" : "OPAQUE", + "TYPE" : 10, + "UID" : "8f060ff2-28bc-4e32-8ba6-3d03dd40d900" + } + } +}
\ No newline at end of file diff --git a/t/scalar-properties.t b/t/scalar-properties.t new file mode 100644 index 0000000..3384166 --- /dev/null +++ b/t/scalar-properties.t @@ -0,0 +1,100 @@ +#!perl -w + +my $loaded; + +use strict; + +use constant num_one => 1; +use constant num_two => 2; +use constant txt_one => 'one'; +use constant txt_two => 'two'; + +use Data::Compare; + +$| = 1; +eval 'use Scalar::Properties'; +print (($@) ? "1..0 # Skipping no Scalar::Properties found\n" : "1..17\n"); +exit(0) if($@); + +my $test = 0; +print "ok ".(++$test)." load module\n"; + +eval q{ + +use Scalar::Properties; + +# test SP vs SP + +my($sp1, $sp2) = (1, 1); +print 'not ' unless(Compare($sp1, $sp2)); +print 'ok '.(++$test)." SPs with same value, no properties compare the same\n"; + +($sp1, $sp2) = (1, 2); +print 'not ' if(Compare($sp1, $sp2)); +print 'ok '.(++$test)." SPs with different values, no properties compare different\n"; + +($sp1, $sp2) = (1->a('frob')->b(num_one), 1->a('frob')->b(num_one)); +print 'not ' unless(Compare($sp1, $sp2)); +print 'ok '.(++$test)." SPs with same value, same properties compare the same\n"; + +($sp1, $sp2) = (1->a('foo')->b(num_one), 1->a('frob')->b(num_one)); +print 'not ' if(Compare($sp1, $sp2)); +print 'ok '.(++$test)." SPs same value, different properties compare different\n"; + +($sp1, $sp2) = (1->a('frob')->b(num_one), 2->a('frob')->b(num_one)); +print 'not ' if(Compare($sp1, $sp2)); +print 'ok '.(++$test)." SPs different value, same properties compare different\n"; + +($sp1, $sp2) = (1->a('foo')->b(num_one), 2->a('frob')->b(num_one)); +print 'not ' if(Compare($sp1, $sp2)); +print 'ok '.(++$test)." SPs different value, different properties compare different\n"; + +($sp1, $sp2) = (1, 1->a('frob')->b(num_one)); +print 'not ' if(Compare($sp1, $sp2)); +print 'ok '.(++$test)." SPs with same value, one with extra properties compare different\n"; + +($sp1, $sp2) = (1->a('frob')->b(num_one), 1); +print 'not ' if(Compare($sp1, $sp2)); +print 'ok '.(++$test)." (rev) SPs with same value, one with extra properties compare different\n"; + +# test scalar vs SP + +$sp1 = 1; +my $scalar1 = num_one; +print 'not ' unless(Compare($scalar1, $sp1)); +print 'ok '.(++$test)." scalar and S::P with same numeric value compare the same\n"; + +$sp1 = 2; +print 'not ' if(Compare($scalar1, $sp1)); +print 'ok '.(++$test)." scalar and S::P with different numeric value compare different\n"; + +$sp1 = 'one'; +$scalar1 = txt_one; +print 'not ' unless(Compare($scalar1, $sp1)); +print 'ok '.(++$test)." scalar and S::P with same string value compare the same\n"; + +$sp1 = 'two'; +print 'not ' if(Compare($scalar1, $sp1)); +print 'ok '.(++$test)." scalar and S::P with different string value compare different\n"; + +# test SP vs scalar + +$sp1 = 1; +$scalar1 = num_one; +print 'not ' unless(Compare($sp1, $scalar1)); +print 'ok '.(++$test)." (rev) scalar and S::P with same numeric value compare the same\n"; + +$sp1 = 2; +print 'not ' if(Compare($sp1, $scalar1)); +print 'ok '.(++$test)." (rev) scalar and S::P with different numeric value compare different\n"; + +$sp1 = 'one'; +$scalar1 = txt_one; +print 'not ' unless(Compare($sp1, $scalar1)); +print 'ok '.(++$test)." (rev) scalar and S::P with same string value compare the same\n"; + +$sp1 = 'two'; +print 'not ' if(Compare($sp1, $scalar1)); +print 'ok '.(++$test)." (rev) scalar and S::P with different string value compare different\n"; + +} diff --git a/t/taint.t b/t/taint.t new file mode 100644 index 0000000..5a7a990 --- /dev/null +++ b/t/taint.t @@ -0,0 +1,30 @@ +#!perl -w + +use Config; + +if($^O =~ /vms/i) { + # $^X isn't VMS-friendly. I'm disinclined to add a dependency on + # Probe::Perl just for testing this corner-case + print "1..0 # skip - can't reliably taint-test on VMS\n"; +# } elsif($ENV{PERL5LIB}) { +# print "1..0 # skip - can't reliably taint-test with PERL5LIB set\n"; +# } else { +# exec("$^X -Tw -Iblib/lib t/realtainttest"); +# } +} else { + my $perl5lib = $ENV{PERL5LIB} || ''; + $ENV{PERL5LIB} = ''; + exec( + join(' ', + $Config{perlpath}, + '-Tw', + ( + # map { "-I$_" } + map { qq{-I"$_"} } + grep { -d $_ } # bleh, code-refs getting stringified + split(/$Config{path_sep}/, $perl5lib) + ), + 't/realtainttest' + ) + ); +} |