List-Compare-0.53/0000755000175000017500000000000012535073324013554 5ustar jkeenanjkeenanList-Compare-0.53/FAQ0000644000175000017500000000346312367245363014123 0ustar jkeenanjkeenan#$Id$ Q. How can I make comparisons among more than two lists when I don't know in advance how many lists I'll need to compare? A. Write a subroutine which returns a reference to an array. In your program, call that subroutine as needed. Push the array reference returned onto a "list of lists" which is then passed to List::Compare->new(). Example: You have a function, get_random_integers(), which returns a reference to a list of random integers between 0 and 9. The number of items in the list is itself a random integer between 0 and 9. sub get_random_integers { my $listsize = int(rand(10)); # 0..9 my @list; for (0 .. $listsize) { push @list, int(rand(10)); } return \@list; } You call get_random_integers a random number of times between 2 and 11. Why 2? Because List::Compare must compare at least two lists. #!/usr/bin/perl use strict; use warnings; use List::Compare; use Data::Dumper; $Data::Dumper::Indent = 0; my $list_quantity = int(rand(10)) + 2; # must have >= 2 lists my @lol; for (0 .. $list_quantity) { my $listref = get_random_integers(); print Dumper $listref; print "\n"; push @lol, $listref; } my $lc = List::Compare->new(@lol); my (@intersection, @union, @unique, @complement); @intersection = $lc->get_intersection(); @union = $lc->get_union(); @unique = $lc->get_unique(0); # items unique to first list @complement = $lc->get_complement(0); # items found in any list but first print Dumper(\@intersection, \@union, \@unique, \@complement); Just substitute your own list-generating function for get_random_integers() in the example above. For production code, strip out all the calls to Data::Dumper. List-Compare-0.53/META.yml0000664000175000017500000000134112535073324015026 0ustar jkeenanjkeenan--- abstract: 'Compare elements of two or more lists' author: - 'James E Keenan (jkeenan@cpan.org)' build_requires: ExtUtils::MakeMaker: '0' IO::CaptureOutput: '0' Test::Simple: '0.1' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.02, CPAN::Meta::Converter version 2.142690' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: List-Compare no_index: directory: - t - inc resources: bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=List-Compare homepage: http://thenceforward.net/perl/modules/List-Compare/ repository: https://github.com/jkeenan/list-compare.git version: '0.53' List-Compare-0.53/MANIFEST.SKIP0000644000175000017500000000046312535065014015452 0ustar jkeenanjkeenan^blib/ ^Makefile$ ^Makefile\.[a-z]+$ ^pm_to_blib$ CVS/.* ,v$ ^tmp/ \.old$ \.bak$ \.tmp$ \.swp$ ~$ ^# \.shar$ \.tar$ \.tgz$ \.tar\.gz$ \.zip$ \.DS_Store$ _uu$ \.svn cover_db/ coverage/ html/ learn/ research/ superseded/ svndiff/ ^Todo ^.cvsignore ^init ^results ^htmlify .git/ ^MYMETA.* nytprof/ nytprof.out List-Compare-0.53/Changes0000644000175000017500000002103612535073221015045 0ustar jkeenanjkeenanRevision history for Perl extension List::Compare. 0.04 Sat Jun 8 2002 - last draft version before using h2xs 0.05 Sun Jun 9 2002 - original version; created by h2xs 1.20 with options -XA -n List::Compare 0.06 Wed Jun 12 2002 - documentation changes; POD broke 0.07 Thu Jun 13 2002 - documentation changes 0.08 Sat Jun 15 2002 - added method get_version() - used non-idiomatic syntax for 'foreach' in hope of making module more backwardly compatible - to free up memory, zeroed out %seenA and %seenB when no longer needed - added method get_bag() - inspired by Set::Scalar, used typeglob syntax to implement aliases for methods - revised POD extensively 0.09 Sun Jun 16 2002 - added tests to test get_bag() - implemented Carp module for warnings 0.10 Wed Jun 19 2002 - corrected one typo in documentation - commented out # require 5.00562 and use warnings - first version uploaded to CPAN 0.11 Thu Jun 20 2002 - corrected errors in POD that caused HTML to display incorrectly 0.12 Sat Jul 13 2002 - major expansion - capability to accelerate processing of comparisons of 2 lists when only 1 comparison method is expected to be called - capability to compare more than 2 lists at a time - introduction of methods including: get_shared() get_nonintersection() print_subset_map() print_equivalence_map() - not released to CPAN due to errors in README and Changes 0.13 Sat Aug 03 2002 - corrected documentation errors found in v0.12 - released to CPAN 0.14 Sun Aug 18 2002 - commented out 'use warnings;' to permit module to run on pre-5.6 versions - corrected one error in POD - removed e-mail addresses of authors of other modules from POD 0.15 Sat Sep 07 2002 - conformed CPAN addresses of other modules to new structure of search.cpan.org 0.16 Sat Mar 08 2003 - for each method which returned an array, added an analogous method which returns a reference to that array 0.17 Thu May 22 2003 - eliminated certain synthetic variables - created List::Compare::SeenHash 0.18 Sun Jun 1 2003 - added methods member_which(), single_member_which() 0.19 Sun Jun 1 2003 - added methods member_any(), single_member_any() - fixed annoying carping messages when running 'make test' 0.20 Fri Jun 6 2003 - updated documentation discussing changes since v0.17 - changed names of recently added methods to is_member_which(), is_member_which_ref(), are_members(), is_member_any(), are_members_any() 0.21 Sun Oct 26 2003 - added functional interface to list comparison functions: List::Compare::Functional; this required changes in List::Compare::Base::Accelerated and the creation of List::Compare::Base::_Engine 0.22 Sun Nov 23 2003 - corrected conceptual flaw in List::Compare::SeenHash so as to exclude values in a seen-hash mathematically equal to zero - implemented 'unsorted' option for list comparisons 0.23 [Accidentally skipped.] 0.24 Sun Mar 28 2004 - first implementation of 'multiple accelerated' mode wherein user can request speedier processing of more than two lists when only one comparison among the lists is sought - converted test suite to use Test::Simple 0.25 Sun Apr 4 2004 - continued implementation of 'multiple accelerated' mode; applied to List::Compare::SeenHash and List::Compare::Functional - modification of interfaces to methods/functions are_members_which() and are_members_any throughout; items to be tested must be passed (by reference) as an anonymous array rather than as a flat list 0.26 Sun Apr 11 2004 - List::Compare::SeenHash and associated tests deprecated - capacity to pass references to seen-hashes to constructor now transferred directly into List::Compare - corrections to POD 0.27 Sun Apr 18 2004 - corrections to POD 0.28 Sun Apr 25 2004 - implementation of is_LdisjointR - correction of error in tests of multiple-accelerated mode - correction of error in internal subroutine _argument_checker_0 - further implication of deprecation of List::Compare::SeenHash is that all the code in List::Compare::Base::Regular, L:C:B:Accelerated, L:C:B:Multiple and L:C:B:Multiple::Accelerated is no longer shared between List::Compare and List::Compare::SeenHash and hence can be taken back into List::Compare; thereby eliminating the 'use base' calls from List::Compare. 0.29 Sun May 16 2004 - implementation of alternative ('Adlerian') interface wherein a single hash reference is passed to constructor or function 0.30 Fri May 21 2004 - documentation corrections only 0.31 Sun Aug 15 2004 - added methods get_unique_all() and get_complement_all(); added 3335 tests; repositioned most methods in List::Compare::Base::_Engine to List::Compare::Accelerated as they were no longer also being used in List::Compare::Functional; other internal code clean-up 0.32 Sun Sep 18 2005 - No changes in functionality. Distribution restructured so that modules are now underneath the 'lib/' directory. 0.33 Sun Feb 19 2006 - Documentation changes only. Support for List-Compare is now offered via dedicated mailing list. 0.34 Mon Nov 5 18:35:15 EST 2007 - Add require 5.6 to Makefile.PL. 0.35 Sun May 18 19:54:32 EDT 2008 - Fix bug reported by Charles Bailey. In object-oriented interface, two lists case, get_shared and get_shared_ref should default to get_intersection and get_intersection_ref. - Complete overhaul of test suite. Tests are now grouped by interface in a more logical order. 0.36 Fri May 23 21:41:55 EDT 2008 - IO::CaptureOutput was mispositioned: should have been directly under t/ rather than under t/Test/. 0.37 Sat Jun 7 19:46:52 EDT 2008 - Tests refined and code refactored so as to achieve 100% subroutine, statement, branch and condition coverage by test suite as measured by Devel::Cover. Some cleanup of POD. 0.38 Thu Sep 5 21:09:10 EDT 2013 - Update support information; no longer using dedicated mailing list. 0.39 Fri Jul 4 15:38:24 EDT 2014 - Repository migrated from Subversion to git. Development repository initiated at https://github.com/jkeenan/list-compare. 0.40 Sat Feb 7 08:39:06 EST 2015 - Eliminated three unnecessary hash assignments. 0.41 Sun Feb 8 20:38:46 EST 2015 - Revised List::Compare::Functional::_intersection_engine() to eliminate need to call _calculate_xintersection_only() and _calculate_hash_intersection(); 0.42 Wed Feb 11 20:57:43 EST 2015 - Improve performance of four List::Compare::Functional functions. get_nonintersection get_nonintersection_ref get_symmetric_difference get_symmetric_difference_ref 0.43 Thu Feb 12 19:14:35 EST 2015 - Improve performance of two List::Compare::Functional functions. get_shared get_shared_ref 0.44 Sun Feb 15 14:40:06 EST 2015 - Improve performance of complement-related functions in both functional and object-oriented interfaces: get_complement get_complement_ref get_complement_all 0.45 Mon Feb 16 16:59:03 EST 2015 - Improve performance of unique-related functions in both functional and object-oriented interfaces: get_unique get_unique_ref get_unique_all 0.46 Wed Feb 18 19:30:30 EST 2015 - Improve performance of List::Compare::Multiple::Accelerated methods: get_intersection get_intersection_ref get_shared get_shared_ref 0.47 Sun Feb 22 08:17:54 EST 2015 - Improve performance of List::Compare::Multiple::Accelerated methods: get_nonintersection get_nonintersection_ref get_symmetric_difference get_symmetric_difference_ref 0.48 Wed Feb 25 17:59:30 EST 2015 - Improve performance of is_LdisjointR in List::Compare::Functional and in multiple accelerated mode of List::Compare. 0.49 Sun Mar 8 20:06:20 EDT 2015 - Add metadata to Makefile.PL. 0.50 Sat May 9 09:06:41 EDT 2015 - Improve performance of is_LsubsetR via patches submitted by Mich Rawson at New York Perl Hackathon (May 2 2015). 0.51 Thu May 14 21:49:00 EDT 2015 - Changes to List::Compare::Functional::is_LsubsetR introduced in v0.50 found to be buggy. See: https://rt.cpan.org/Ticket/Display.html?id=104452. Pending further investigation, reverted to v0.49 of List::Compare::Base::_Auxiliary; added two test files. 0.52 Thu May 21 21:57:18 EDT 2015 - v0.51 changes were not applied to master branch; apply them. Remove two hash-to-hash assignments in List::Compare::Base::_Auxiliary::_subset_subengine. 0.53 Sun Jun 7 10:49:24 MDT 2015 - Accept patch submitted by Paulo Custodio reworking, and correcting, changes originally published in 0.50. List-Compare-0.53/META.json0000664000175000017500000000244612535073324015205 0ustar jkeenanjkeenan{ "abstract" : "Compare elements of two or more lists", "author" : [ "James E Keenan (jkeenan@cpan.org)" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.02, CPAN::Meta::Converter version 2.142690", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "List-Compare", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "test" : { "requires" : { "IO::CaptureOutput" : "0", "Test::Simple" : "0.1" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=List-Compare" }, "homepage" : "http://thenceforward.net/perl/modules/List-Compare/", "repository" : { "type" : "git", "url" : "https://github.com/jkeenan/list-compare.git", "web" : "https://github.com/jkeenan/list-compare" } }, "version" : "0.53" } List-Compare-0.53/.gitignore0000644000175000017500000000032712535065014015543 0ustar jkeenanjkeenan/blib/ /.build/ _build/ cover_db/ inc/ Build !Build/ Build.bat .last_cover_stats /Makefile /Makefile.old /MANIFEST.bak /META.yml /META.json /MYMETA.* nytprof.out /pm_to_blib *.o *.bs List-Compare-*.tar.gz /nytprof/ List-Compare-0.53/MANIFEST0000644000175000017500000000417012535073324014707 0ustar jkeenanjkeenan.gitignore Changes FAQ lib/List/Compare.pm lib/List/Compare/Base/_Auxiliary.pm lib/List/Compare/Base/_Engine.pm lib/List/Compare/Functional.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP README t/01_oo_lists_dual_reg_sorted.t t/02_oo_lists_dual_reg_unsorted.t t/03_oo_lists_dual_acc_sorted.t t/04_oo_lists_dual_acc_unsorted.t t/05_oo_lists_mult_reg_sorted.t t/06_oo_lists_mult_reg_unsorted.t t/07_oo_lists_mult_acc_sorted.t t/08_oo_lists_mult_acc_unsorted.t t/09_oo_lists_alt_dual_reg_sorted.t t/10_oo_lists_alt_dual_reg_unsorted.t t/11_oo_lists_alt_dual_acc_sorted.t t/12_oo_lists_alt_dual_acc_unsorted.t t/13_oo_lists_alt_mult_reg_sorted.t t/14_oo_lists_alt_mult_reg_unsorted.t t/15_oo_lists_alt_mult_acc_sorted.t t/16_oo_lists_alt_mult_acc_unsorted.t t/17_oo_hashes_dual_reg_sorted.t t/18_oo_hashes_dual_reg_unsorted.t t/19_oo_hashes_dual_acc_sorted.t t/20_oo_hashes_dual_acc_unsorted.t t/21_oo_hashes_mult_reg_sorted.t t/22_oo_hashes_mult_reg_unsorted.t t/23_oo_hashes_mult_acc_sorted.t t/24_oo_hashes_mult_acc_unsorted.t t/25_oo_hashes_alt_dual_reg_sorted.t t/26_oo_hashes_alt_dual_reg_unsorted.t t/27_oo_hashes_alt_dual_acc_sorted.t t/28_oo_hashes_alt_dual_acc_unsorted.t t/29_oo_hashes_alt_mult_reg_sorted.t t/30_oo_hashes_alt_mult_reg_unsorted.t t/31_oo_hashes_alt_mult_acc_sorted.t t/32_oo_hashes_alt_mult_acc_unsorted.t t/33_func_lists_dual_sorted.t t/34_func_lists_dual_unsorted.t t/35_func_lists_mult_sorted.t t/36_func_lists_mult_unsorted.t t/37_func_lists_alt_dual_sorted.t t/38_func_lists_alt_dual_unsorted.t t/39_func_lists_alt_mult_sorted.t t/40_func_lists_alt_mult_unsorted.t t/41_func_hashes_dual_sorted.t t/42_func_hashes_dual_unsorted.t t/43_func_hashes_mult_sorted.t t/44_func_hashes_mult_unsorted.t t/45_func_hashes_alt_dual_sorted.t t/46_func_hashes_alt_dual_unsorted.t t/47_func_hashes_alt_mult_sorted.t t/48_func_hashes_alt_mult_unsorted.t t/49_lc_subset.t t/50_lcf_subset.t t/90_oo_errors.t t/91_func_errors.t t/IO/CaptureOutput.pm t/Test/ListCompareSpecial.pm META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) List-Compare-0.53/Makefile.PL0000644000175000017500000000207412535065014015526 0ustar jkeenanjkeenanuse ExtUtils::MakeMaker; require 5.006; my $mm_ver = ExtUtils::MakeMaker->VERSION; WriteMakefile( NAME => 'List::Compare', AUTHOR => 'James E Keenan (jkeenan@cpan.org)', VERSION_FROM => 'lib/List/Compare.pm', ABSTRACT_FROM => 'lib/List/Compare.pm', ( $mm_ver < 6.63_03 ? 'BUILD_REQUIRES' : 'TEST_REQUIRES' ) => { 'IO::CaptureOutput' => 0, 'Test::Simple' => 0.10, }, LICENSE => "perl", ($mm_ver < 6.46 ? () : (META_MERGE => { 'meta-spec' => { version => 2 }, dynamic_config => 1, resources => { homepage => 'http://thenceforward.net/perl/modules/List-Compare/', repository => { url => 'https://github.com/jkeenan/list-compare.git', web => 'https://github.com/jkeenan/list-compare', type => 'git', }, bugtracker => { web => 'https://rt.cpan.org/Public/Dist/Display.html?Name=List-Compare', }, }, })), ); List-Compare-0.53/README0000644000175000017500000000621512535072713014441 0ustar jkeenanjkeenanList::Compare - Compare elements of two or more lists This document refers to version 0.53 of List::Compare. This version was released June 07 2015. To install this module on your system, place the tarball archive file in a temporary directory and call the following: % gunzip List-Compare-0.53.tar.gz % tar xf List-Compare-0.53.tar % cd List-Compare-0.53 % perl Makefile.PL % make % make test % make install If during installation you wish to view more information on test results, substitute the fllowing for the sixth line in the sequence of commands above: % make test TEST=VERBOSE If you are installing this module over any earlier version, you may substitute the following for the last line in the sequence of commands above: % make install UNINST=1 If you are installing this module on a Win32 system with 'nmake', substitute 'nmake' for 'make' in the sequence of commands above. The author has found that trying to install this distribution with (a) older (pre-6.16) versions of ExtUtils::MakeMaker, (b) on older versions of Perl (e.g., 5.6.0), and (c) on older Linux distributions (e.g., RedHat Linux 7.3) can result in a situation where the module's Plain Old Documentation, when transformed into manual pages, is not automatically placed in the optimal location for reading thru 'man' and 'info' (even though it reads perfectly through 'perldoc'). If you experience this problem, issue the following at the command line (adapted from a suggestion by Michael Schwern on the module-authors mailing list): % perl Makefile.PL INSTALLSITEMAN3DIR=/usr/share/man/man3 List::Compare uses the Carp module which is part of the standard Perl distribution. Other than that, there are no module dependencies in this version of List::Compare. Certain methods in this version of List::Compare are included solely for backwards compatibility with earlier versions and are deprecated. When called, they print warning messages via Carp. In earlier versions of List::Compare these warning messages would appear when you called 'make test' as part of the installation process. This was harmless but annoying and has been fixed. Beginning with version 0.25 in April 2004, there is a modification to the interface of two methods/functions: are_members_which() and are_members_any(). Whereas previously the strings to be tested could be passed to the subroutine either as a flat list or via a reference to an anonymous array, now those items must be passed via reference to an anonymous array. Beginning with version 0.26 in April 2004, the functionality previously found in List::Compare::SeenHash has been incorporated directly into List::Compare. Hence, List::Compare::SeenHash and the test suite files associated with it have been deprecated and are no longer included in the CPAN distribution. Please see the List::Compare documentation for further details. In sending e-mail to the author, please put "List::Compare" or "List-Compare" in the subject line. Author: James E. Keenan (jkeenan@cpan.org). Originally created May 20, 2002. Copyright (c) 2002-15 James E. Keenan. United States. All rights reserved. This is free software and may be distributed under the same terms as Perl itself. List-Compare-0.53/t/0000755000175000017500000000000012535073324014017 5ustar jkeenanjkeenanList-Compare-0.53/t/19_oo_hashes_dual_acc_sorted.t0000755000175000017500000002447112465263760021702 0ustar jkeenanjkeenan# perl #$Id$ # 19_oo_hashes_dual_acc_sorted.t use strict; use Test::More tests => 79; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :hashes :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; ### new ### my $lc = List::Compare->new('-a', \%h0, \%h1); ok($lc, "List::Compare constructor returned true value"); @pred = qw(abel baker camera delta edward fargo golfer hilton); @union = $lc->get_union; is_deeply( \@union, \@pred, "Got expected union"); $union_ref = $lc->get_union_ref; is_deeply( $union_ref, \@pred, "Got expected union"); { my ($rv, $stdout, $stderr); capture( sub { @shared = $lc->get_shared; }, \$stdout, \$stderr, ); is_deeply( \@shared, \@pred, "Got expected shared"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } { my ($rv, $stdout, $stderr); capture( sub { $shared_ref = $lc->get_shared_ref; }, \$stdout, \$stderr, ); is_deeply( $shared_ref, \@pred, "Got expected shared"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } @pred = qw( baker camera delta edward fargo golfer ); @intersection = $lc->get_intersection; is_deeply(\@intersection, \@pred, "Got expected intersection"); $intersection_ref = $lc->get_intersection_ref; is_deeply($intersection_ref, \@pred, "Got expected intersection"); @pred = qw( abel ); @unique = $lc->get_unique; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lc->get_unique_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); @unique = $lc->get_Lonly; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lc->get_Lonly_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); @unique = $lc->get_Aonly; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lc->get_Aonly_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); @pred = ( [ 'abel' ], [ 'hilton' ], ); $unique_all_ref = $lc->get_unique_all(); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_unique_all()"); @pred = qw ( hilton ); @complement = $lc->get_complement; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lc->get_complement_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); @complement = $lc->get_Ronly; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lc->get_Ronly_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); @complement = $lc->get_Bonly; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lc->get_Bonly_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); @pred = ( [ qw( hilton ) ], [ qw( abel ) ], ); $complement_all_ref = $lc->get_complement_all(); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); @pred = qw( abel hilton ); @symmetric_difference = $lc->get_symmetric_difference; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_symmetric_difference_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lc->get_symdiff; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_symdiff_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lc->get_LorRonly; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_LorRonly_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lc->get_AorBonly; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_AorBonly_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @pred = qw( abel hilton ); { my ($rv, $stdout, $stderr); capture( sub { @nonintersection = $lc->get_nonintersection; }, \$stdout, \$stderr, ); is_deeply( \@nonintersection, \@pred, "Got expected nonintersection"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } { my ($rv, $stdout, $stderr); capture( sub { $nonintersection_ref = $lc->get_nonintersection_ref; }, \$stdout, \$stderr, ); is_deeply($nonintersection_ref, \@pred, "Got expected nonintersection"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } @pred = qw( abel abel baker baker camera camera delta delta delta edward edward fargo fargo golfer golfer hilton ); @bag = $lc->get_bag; is_deeply(\@bag, \@pred, "Got expected bag"); $bag_ref = $lc->get_bag_ref; is_deeply($bag_ref, \@pred, "Got expected bag"); $LR = $lc->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); $LR = $lc->is_AsubsetB; ok(! $LR, "Got expected subset relationship"); $RL = $lc->is_RsubsetL; ok(! $RL, "Got expected subset relationship"); $RL = $lc->is_BsubsetA; ok(! $RL, "Got expected subset relationship"); $eqv = $lc->is_LequivalentR; ok(! $eqv, "Got expected equivalent relationship"); $eqv = $lc->is_LeqvlntR; ok(! $eqv, "Got expected equivalent relationship"); $disj = $lc->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lc->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lc->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } ok(wrap_is_member_which( $lc, $test_members_which, ), "is_member_which() returned all expected values"); eval { $memb_arr_ref = $lc->is_member_which('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which() correctly generated error message"); ok(wrap_is_member_which_ref( $lc, $test_members_which, ), "is_member_which_ref() returned all expected values"); eval { $memb_arr_ref = $lc->is_member_which_ref('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which_ref() correctly generated error message"); $memb_hash_ref = $lc->are_members_which( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); ok(wrap_are_members_which( $memb_hash_ref, $test_members_which, ), "are_members_which() returned all expected value"); eval { $memb_hash_ref = $lc->are_members_which( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_which() correctly generated error message"); ok(wrap_is_member_any( $lc, $test_members_any, ), "is_member_any() returned all expected values"); eval { $lc->is_member_any('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_any() correctly generated error message"); $memb_hash_ref = $lc->are_members_any( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); ok(wrap_are_members_any( $memb_hash_ref, $test_members_any, ), "are_members_any() returned all expected values"); eval { $memb_hash_ref = $lc->are_members_any( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_any() correctly generated error message"); $vers = $lc->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lc_s = List::Compare->new('-a', \%h2, \%h3); ok($lc_s, "constructor returned true value"); $LR = $lc_s->is_LsubsetR; ok(! $LR, "non-subset correctly determined"); $LR = $lc_s->is_AsubsetB; ok(! $LR, "non-subset correctly determined"); $RL = $lc_s->is_RsubsetL; ok($RL, "subset correctly determined"); $RL = $lc_s->is_BsubsetA; ok($RL, "subset correctly determined"); $eqv = $lc_s->is_LequivalentR; ok(! $eqv, "non-equivalence correctly determined"); $eqv = $lc_s->is_LeqvlntR; ok(! $eqv, "non-equivalence correctly determined"); $disj = $lc_s->is_LdisjointR; ok(! $disj, "non-disjoint correctly determined"); ### new ### my $lc_e = List::Compare->new('-a', \%h3, \%h4); ok($lc_e, "constructor returned true value"); $eqv = $lc_e->is_LequivalentR; ok($eqv, "equivalence correctly determined"); $eqv = $lc_e->is_LeqvlntR; ok($eqv, "equivalence correctly determined"); $disj = $lc_e->is_LdisjointR; ok(! $disj, "non-disjoint correctly determined"); ### new ### my $lc_dj = List::Compare->new('-a', \%h4, \%h8); ok($lc_dj, "constructor returned true value"); ok(0 == $lc_dj->get_intersection, "no intersection, as expected"); ok(0 == scalar(@{$lc_dj->get_intersection_ref}), "no intersection, as expected"); $disj = $lc_dj->is_LdisjointR; ok($disj, "disjoint correctly determined"); ########## BELOW: Tests for '--accelerated' option ########## my $lcacc = List::Compare->new('--accelerated', \%h0, \%h1); ok($lcacc, "Constructor worked with --accelerated option"); my $lcacc_s = List::Compare->new('--accelerated', \%h2, \%h3); ok($lcacc_s, "Constructor worked with --accelerated option"); my $lcacc_e = List::Compare->new('--accelerated', \%h3, \%h4); ok($lcacc_e, "Constructor worked with --accelerated option"); ########## BELOW: Test for bad arguments to constructor ########## my ($lc_bad); eval { $lc_bad = List::Compare->new('-a', \%h0) }; like($@, qr/Must pass at least 2 references/, "Got expected error message from bad constructor"); List-Compare-0.53/t/38_func_lists_alt_dual_unsorted.t0000755000175000017500000001650612465263760022501 0ustar jkeenanjkeenan# perl #$Id$ # 38_func_lists_alt_dual_unsorted.t use strict; use Test::More tests => 38; use List::Compare::Functional qw(:originals :aliases); use lib ("./t"); use Test::ListCompareSpecial qw( :seen :func_wrap :arrays :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref); my @args; %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton ); @unpred = qw| icon jerky |; @union = get_union( { lists => [ \@a0, \@a1 ], unsorted => 1} ); $seen{$_}++ foreach (@union); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); $union_ref = get_union_ref( { lists => [ \@a0, \@a1 ], unsorted => 1} ); $seen{$_}++ foreach (@{$union_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer ); @unpred = qw| abel hilton icon jerky |; @shared = get_shared( { lists => [ \@a0, \@a1 ], unsorted => 1} ); $seen{$_}++ foreach (@shared); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); $shared_ref = get_shared_ref( { lists => [ \@a0, \@a1 ], unsorted => 1} ); $seen{$_}++ foreach (@{$shared_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer ); @unpred = qw| abel hilton icon jerky |; @intersection = get_intersection( { lists => [ \@a0, \@a1 ], unsorted => 1} ); $seen{$_}++ foreach (@intersection); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); $intersection_ref = get_intersection_ref( { lists => [ \@a0, \@a1 ], unsorted => 1} ); $seen{$_}++ foreach (@{$intersection_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel ); @unpred = qw| baker camera delta edward fargo golfer hilton icon jerky |; @unique = get_unique( { lists => [ \@a0, \@a1 ], unsorted => 1} ); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = get_unique_ref( { lists => [ \@a0, \@a1 ], unsorted => 1} ); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ 'abel' ], [ 'hilton' ], ); $unique_all_ref = get_unique_all( { lists => [ \@a0, \@a1 ], unsorted => 1} ); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_unique_all()"); %pred = map {$_, 1} qw( hilton ); @unpred = qw| abel baker camera delta edward fargo golfer icon jerky |; @complement = get_complement( { lists => [ \@a0, \@a1 ], unsorted => 1} ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = get_complement_ref( { lists => [ \@a0, \@a1 ], unsorted => 1} ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ qw( hilton ) ], [ qw( abel ) ], ); $complement_all_ref = get_complement_all( { lists => [ \@a0, \@a1 ], unsorted => 1} ); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %pred = map {$_, 1} qw( abel hilton ); @unpred = qw| baker camera delta edward fargo golfer icon jerky |; @symmetric_difference = get_symmetric_difference( { lists => [ \@a0, \@a1 ], unsorted => 1} ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = get_symmetric_difference_ref( { lists => [ \@a0, \@a1 ], unsorted => 1} ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = get_symdiff( { lists => [ \@a0, \@a1 ], unsorted => 1} ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = get_symdiff_ref( { lists => [ \@a0, \@a1 ], unsorted => 1} ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel hilton ); @unpred = qw| baker camera delta edward fargo golfer icon jerky |; @nonintersection = get_nonintersection( { lists => [ \@a0, \@a1 ], unsorted => 1} ); $seen{$_}++ foreach (@nonintersection); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); $nonintersection_ref = get_nonintersection_ref( { lists => [ \@a0, \@a1 ], unsorted => 1} ); $seen{$_}++ foreach (@{$nonintersection_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); %pred = ( abel => 2, baker => 2, camera => 2, delta => 3, edward => 2, fargo => 2, golfer => 2, hilton => 1, ); @unpred = qw| icon jerky |; @bag = get_bag( { lists => [ \@a0, \@a1 ], unsorted => 1} ); $seen{$_}++ foreach (@bag); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $bag_ref = get_bag_ref( { lists => [ \@a0, \@a1 ], unsorted => 1} ); $seen{$_}++ foreach (@{$bag_ref}); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); List-Compare-0.53/t/46_func_hashes_alt_dual_unsorted.t0000755000175000017500000001650712465263760022616 0ustar jkeenanjkeenan# perl #$Id$ # 46_func_hashes_alt_dual_unsorted.t use strict; use Test::More tests => 38; use List::Compare::Functional qw(:originals :aliases); use lib ("./t"); use Test::ListCompareSpecial qw( :seen :func_wrap :hashes :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref); my @args; %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton ); @unpred = qw| icon jerky |; @union = get_union( { lists => [ \%h0, \%h1 ], unsorted => 1} ); $seen{$_}++ foreach (@union); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); $union_ref = get_union_ref( { lists => [ \%h0, \%h1 ], unsorted => 1} ); $seen{$_}++ foreach (@{$union_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer ); @unpred = qw| abel hilton icon jerky |; @shared = get_shared( { lists => [ \%h0, \%h1 ], unsorted => 1} ); $seen{$_}++ foreach (@shared); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); $shared_ref = get_shared_ref( { lists => [ \%h0, \%h1 ], unsorted => 1} ); $seen{$_}++ foreach (@{$shared_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer ); @unpred = qw| abel hilton icon jerky |; @intersection = get_intersection( { lists => [ \%h0, \%h1 ], unsorted => 1} ); $seen{$_}++ foreach (@intersection); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); $intersection_ref = get_intersection_ref( { lists => [ \%h0, \%h1 ], unsorted => 1} ); $seen{$_}++ foreach (@{$intersection_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel ); @unpred = qw| baker camera delta edward fargo golfer hilton icon jerky |; @unique = get_unique( { lists => [ \%h0, \%h1 ], unsorted => 1} ); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = get_unique_ref( { lists => [ \%h0, \%h1 ], unsorted => 1} ); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ 'abel' ], [ 'hilton' ], ); $unique_all_ref = get_unique_all( { lists => [ \%h0, \%h1 ], unsorted => 1} ); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_unique_all()"); %pred = map {$_, 1} qw( hilton ); @unpred = qw| abel baker camera delta edward fargo golfer icon jerky |; @complement = get_complement( { lists => [ \%h0, \%h1 ], unsorted => 1} ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = get_complement_ref( { lists => [ \%h0, \%h1 ], unsorted => 1} ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ qw( hilton ) ], [ qw( abel ) ], ); $complement_all_ref = get_complement_all( { lists => [ \%h0, \%h1 ], unsorted => 1} ); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %pred = map {$_, 1} qw( abel hilton ); @unpred = qw| baker camera delta edward fargo golfer icon jerky |; @symmetric_difference = get_symmetric_difference( { lists => [ \%h0, \%h1 ], unsorted => 1} ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = get_symmetric_difference_ref( { lists => [ \%h0, \%h1 ], unsorted => 1} ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = get_symdiff( { lists => [ \%h0, \%h1 ], unsorted => 1} ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = get_symdiff_ref( { lists => [ \%h0, \%h1 ], unsorted => 1} ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel hilton ); @unpred = qw| baker camera delta edward fargo golfer icon jerky |; @nonintersection = get_nonintersection( { lists => [ \%h0, \%h1 ], unsorted => 1} ); $seen{$_}++ foreach (@nonintersection); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); $nonintersection_ref = get_nonintersection_ref( { lists => [ \%h0, \%h1 ], unsorted => 1} ); $seen{$_}++ foreach (@{$nonintersection_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); %pred = ( abel => 2, baker => 2, camera => 2, delta => 3, edward => 2, fargo => 2, golfer => 2, hilton => 1, ); @unpred = qw| icon jerky |; @bag = get_bag( { lists => [ \%h0, \%h1 ], unsorted => 1} ); $seen{$_}++ foreach (@bag); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $bag_ref = get_bag_ref( { lists => [ \%h0, \%h1 ], unsorted => 1} ); $seen{$_}++ foreach (@{$bag_ref}); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); List-Compare-0.53/t/14_oo_lists_alt_mult_reg_unsorted.t0000755000175000017500000004324212465263760023043 0ustar jkeenanjkeenan# perl #$Id$ # 14_oo_lists_alt_mult_reg_unsorted.t use strict; use Test::More tests => 110; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :arrays :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; ### new ### my $lcmu = List::Compare->new( { unsorted => 1, lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], } ); ok($lcmu, "List::Compare constructor returned true value"); %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton icon jerky ); @unpred = qw| kappa |; @union = $lcmu->get_union; $seen{$_}++ foreach (@union); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); $union_ref = $lcmu->get_union_ref; $seen{$_}++ foreach (@{$union_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer hilton icon ); @unpred = qw| abel jerky |; @shared = $lcmu->get_shared; $seen{$_}++ foreach (@shared); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); $shared_ref = $lcmu->get_shared_ref; $seen{$_}++ foreach (@{$shared_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( fargo golfer ); @unpred = qw| abel baker camera delta edward hilton icon jerky |; @intersection = $lcmu->get_intersection; $seen{$_}++ foreach (@intersection); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); $intersection_ref = $lcmu->get_intersection_ref; $seen{$_}++ foreach (@{$intersection_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( jerky ); @unpred = qw| abel baker camera delta edward fargo golfer hilton icon |; @unique = $lcmu->get_unique(2); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcmu->get_unique_ref(2); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @unique = $lcmu->get_Lonly(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $unique_ref = $lcmu->get_Lonly_ref(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { @unique = $lcmu->get_Aonly(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $unique_ref = $lcmu->get_Aonly_ref(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); @pred = ( [ 'abel' ], [ ], [ 'jerky' ], [ ], [ ], ); $unique_all_ref = $lcmu->get_unique_all(); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %pred = map {$_, 1} qw( abel icon jerky ); @unpred = qw| baker camera delta edward fargo golfer hilton |; @complement = $lcmu->get_complement(1); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcmu->get_complement_ref(1); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @complement = $lcmu->get_Bonly(1); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $complement_ref = $lcmu->get_Bonly_ref(1); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); %pred = map {$_, 1} qw( hilton icon jerky ); @unpred = qw| abel baker camera delta edward fargo golfer |; @complement = $lcmu->get_complement; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcmu->get_complement_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @complement = $lcmu->get_Ronly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $complement_ref = $lcmu->get_Ronly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { @complement = $lcmu->get_Bonly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $complement_ref = $lcmu->get_Bonly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); %pred = map {$_, 1} qw( abel jerky ); @unpred = qw| baker camera delta edward fargo golfer hilton icon |; @symmetric_difference = $lcmu->get_symmetric_difference; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcmu->get_symmetric_difference_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcmu->get_symdiff; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcmu->get_symdiff_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @symmetric_difference = $lcmu->get_LorRonly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } %seen = (); { my ($stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcmu->get_LorRonly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); } %seen = (); { my ($stdout, $stderr); capture( sub { @symmetric_difference = $lcmu->get_AorBonly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } %seen = (); { my ($stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcmu->get_AorBonly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); } %seen = (); @pred = ( [ qw( hilton icon jerky ) ], [ qw( abel icon jerky ) ], [ qw( abel baker camera delta edward ) ], [ qw( abel baker camera delta edward jerky ) ], [ qw( abel baker camera delta edward jerky ) ], ); $complement_all_ref = $lcmu->get_complement_all(); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %seen = (); %pred = map {$_, 1} qw( abel baker camera delta edward hilton icon jerky ); @unpred = qw| fargo golfer |; @nonintersection = $lcmu->get_nonintersection; $seen{$_}++ foreach (@nonintersection); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); $nonintersection_ref = $lcmu->get_nonintersection_ref; $seen{$_}++ foreach (@{$nonintersection_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); %pred = ( abel => 2, baker => 2, camera => 2, delta => 3, edward => 2, fargo => 6, golfer => 5, hilton => 4, icon => 5, jerky => 1, ); @unpred = qw| kappa |; @bag = $lcmu->get_bag; $seen{$_}++ foreach (@bag); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $bag_ref = $lcmu->get_bag_ref; $seen{$_}++ foreach (@{$bag_ref}); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $LR = $lcmu->is_LsubsetR(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcmu->is_AsubsetB(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcmu->is_LsubsetR(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcmu->is_AsubsetB(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcmu->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcmu->is_RsubsetL; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcmu->is_BsubsetA; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } $eqv = $lcmu->is_LequivalentR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcmu->is_LeqvlntR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcmu->is_LequivalentR(2,4); ok(! $eqv, "Got expected equivalence relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcmu->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcmu->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); is_deeply( all_is_member_which( $lcmu, \@args), $test_member_which_mult, "is_member_which() returned all expected values"); is_deeply( all_is_member_which_ref( $lcmu, \@args), $test_member_which_mult, "is_member_which_ref() returned all expected values"); $memb_hash_ref = $lcmu->are_members_which( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); is_deeply($memb_hash_ref, $test_members_which_mult, "are_members_which() returned all expected values"); is_deeply( all_is_member_any( $lcmu, \@args), $test_member_any_mult, "is_member_which() returned all expected values"); $memb_hash_ref = $lcmu->are_members_any( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); is_deeply($memb_hash_ref, $test_members_any_mult, "are_members_any() returned all expected values"); $vers = $lcmu->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lcmu_dj = List::Compare->new( { unsorted => 1, lists => [ \@a0, \@a1, \@a2, \@a3, \@a4, \@a8 ], } ); ok($lcmu_dj, "List::Compare constructor returned true value"); $disj = $lcmu_dj->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); $disj = $lcmu_dj->is_LdisjointR(2,3); ok(! $disj, "Got expected disjoint relationship"); $disj = $lcmu_dj->is_LdisjointR(4,5); ok($disj, "Got expected disjoint relationship"); ok($lcmu_dj, "List::Compare constructor returned true value"); List-Compare-0.53/t/IO/0000755000175000017500000000000012535073324014326 5ustar jkeenanjkeenanList-Compare-0.53/t/IO/CaptureOutput.pm0000644000175000017500000001662412367245363017530 0ustar jkeenanjkeenan# $Id: CaptureOutput.pm,v 1.3 2005/03/25 12:44:14 simonflack Exp $ package IO::CaptureOutput; use strict; use vars qw/$VERSION @ISA @EXPORT_OK %EXPORT_TAGS/; use Exporter; @ISA = 'Exporter'; @EXPORT_OK = qw/capture capture_exec qxx capture_exec_combined qxy/; %EXPORT_TAGS = (all => \@EXPORT_OK); $VERSION = '1.06'; sub capture (&@) { ## no critic my ($code, $output, $error) = @_; for ($output, $error) { $_ = \do { my $s; $s = ''} unless ref $_; $$_ = '' unless defined($$_); } my $capture_out = IO::CaptureOutput::_proxy->new('STDOUT', $output); my $capture_err = IO::CaptureOutput::_proxy->new( 'STDERR', $error, $output == $error ? 'STDOUT' : undef ); &$code(); } sub capture_exec { my @args = @_; my ($output, $error); capture sub { system _shell_quote(@args) }, \$output, \$error; return wantarray ? ($output, $error) : $output; } *qxx = \&capture_exec; sub capture_exec_combined { my @args = @_; my $output; capture sub { system _shell_quote(@args) }, \$output, \$output; return $output; } *qxy = \&capture_exec_combined; # extra quoting required on Win32 systems *_shell_quote = ($^O =~ /MSWin32/) ? \&_shell_quote_win32 : sub {@_}; sub _shell_quote_win32 { my @args; for (@_) { if (/[ \"]/) { # TODO: check if ^ requires escaping (my $escaped = $_) =~ s/([\"])/\\$1/g; push @args, '"' . $escaped . '"'; next; } push @args, $_ } return @args; } # Captures everything printed to a filehandle for the lifetime of the object # and then transfers it to a scalar reference package IO::CaptureOutput::_proxy; use File::Temp 'tempfile'; use File::Basename qw/basename/; use Symbol qw/gensym qualify qualify_to_ref/; use Carp; sub _is_wperl { $^O eq 'MSWin32' && basename($^X) eq 'wperl.exe' } sub new { my $class = shift; my ($fh, $capture, $merge_fh) = @_; $fh = qualify($fh); # e.g. main::STDOUT my $fhref = qualify_to_ref($fh); # e.g. \*STDOUT # Duplicate the filehandle my $saved; { no strict 'refs'; ## no critic - needed for 5.005 if ( defined fileno($fh) && ! _is_wperl() ) { $saved = gensym; open $saved, ">&$fh" or croak "Can't redirect <$fh> - $!"; } } # Create replacement filehandle if not merging my ($newio, $newio_file); if ( ! $merge_fh ) { $newio = gensym; (undef, $newio_file) = tempfile; open $newio, "+>$newio_file" or croak "Can't create temp file for $fh - $!"; } else { $newio = qualify($merge_fh); } # Redirect (or merge) { no strict 'refs'; ## no critic -- needed for 5.005 open $fhref, ">&".fileno($newio) or croak "Can't redirect $fh - $!"; } bless [$$, $fh, $saved, $capture, $newio, $newio_file], $class; } sub DESTROY { my $self = shift; my ($pid, $fh, $saved) = @{$self}[0..2]; return unless $pid eq $$; # only cleanup in the process that is capturing # restore the original filehandle my $fh_ref = Symbol::qualify_to_ref($fh); select((select ($fh_ref), $|=1)[0]); if (defined $saved) { open $fh_ref, ">&". fileno($saved) or croak "Can't restore $fh - $!"; } else { close $fh_ref; } # transfer captured data to the scalar reference if we didn't merge my ($capture, $newio, $newio_file) = @{$self}[3..5]; if ($newio_file) { # some versions of perl complain about reading from fd 1 or 2 # which could happen if STDOUT and STDERR were closed when $newio # was opened, so we just squelch warnings here and continue local $^W; seek $newio, 0, 0; $$capture = do {local $/; <$newio>}; close $newio; } # Cleanup return unless defined $newio_file && -e $newio_file; unlink $newio_file or carp "Couldn't remove temp file '$newio_file' - $!"; } 1; __END__ =pod =begin wikidoc = NAME IO::CaptureOutput - capture STDOUT and STDERR from Perl code, subprocesses or XS = VERSION This documentation describes version %%VERSION%%. = SYNOPSIS use IO::CaptureOutput qw(capture capture_exec); my ($stdout, $stderr); sub noisy { warn "this sub prints to stdout and stderr!"; print "arguments: @_"; } capture sub {noisy(@args)}, \$stdout, \$stderr; ($stdout, $stderr) = capture_exec( 'perl', '-e', 'print "Hello"; print STDERR "World!"'); = DESCRIPTION This module provides routines for capturing STDOUT and STDERR from perl subroutines, forked system calls (e.g. {system()}, {fork()}) and from XS or C modules. = FUNCTIONS The following functions will be exported on demand. == capture() capture(\&subroutine, \$stdout, \$stderr); Captures everything printed to {STDOUT} and {STDERR} for the duration of {&subroutine}. {$stdout} and {$stderr} are optional scalars that will contain {STDOUT} and {STDERR} respectively. Returns the return value(s) of {&subroutine}. The sub is called in the same context as {capture()} was called e.g.: @rv = capture(sub {wantarray}); # returns true $rv = capture(sub {wantarray}); # returns defined, but not true capture(sub {wantarray}); # void, returns undef {capture()} is able to capture output from subprocesses and C code, which traditional {tie()} methods of output capture are unable to do. If the two scalar references refer to the same scalar, then {STDERR} will be merged to {STDOUT} before capturing and the scalar will hold the combined output of both. capture(\&subroutine, \$combined, \$combined); *Note:* {capture()} will only capture output that has been written or flushed to the filehandle. == capture_exec() ($stdout, $stderr) = capture_exec(@args); Captures and returns the output from {system(@args)}. In scalar context, {capture_exec()} will return what was printed to {STDOUT}. In list context, it returns what was printed to {STDOUT} and {STDERR} $stdout = capture_exec('perl', '-e', 'print "hello world"'); ($stdout, $stderr) = capture_exec('perl', '-e', 'warn "Test"'); {capture_exec} passes its arguments to {system()} and on MSWin32 will protect arguments with shell quotes if necessary. This makes it a handy and slightly more portable alternative to backticks, piped {open()} and {IPC::Open3}. You can check the exit status of the {system()} call with the {$?} variable. See [perlvar] for more information. == capture_exec_combined() $combined = capture_exec_combined( 'perl', '-e', 'print "hello\n"', 'warn "Test\n" ); This is just like {capture_exec()}, except that it merges {STDERR} with {STDOUT} before capturing output and returns a single scalar. *Note:* there is no guarantee that text printed to {STDOUT} and {STDERR} in the subprocess will be appear in order. The actual order will depend on how IO buffering is handled in the subprocess. == qxx() This is an alias for {capture_exec()}. == qxy() This is an alias for {capture_exec_combined()}. = SEE ALSO * [IPC::Open3] * [IO::Capture] * [IO::Utils] = AUTHORS * Simon Flack (original author) * David Golden (co-maintainer since version 1.04) = COPYRIGHT AND LICENSE Portions copyright 2004, 2005 Simon Flack. Portions copyright 2007 David Golden. All rights reserved. You may distribute under the terms of either the GNU General Public License or the Artistic License, as specified in the Perl README file. =end wikidoc =cut List-Compare-0.53/t/23_oo_hashes_mult_acc_sorted.t0000755000175000017500000004135112471220765021720 0ustar jkeenanjkeenan# perl #$Id$ # 23_oo_hashes_mult_acc_sorted.t use strict; use Test::More tests => 104; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :hashes :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; ### new ### my $lcm = List::Compare->new('-a', \%h0, \%h1, \%h2, \%h3, \%h4); ok($lcm, "List::Compare constructor returned true value"); @pred = qw(abel baker camera delta edward fargo golfer hilton icon jerky); @union = $lcm->get_union; is_deeply( \@union, \@pred, "Got expected union"); $union_ref = $lcm->get_union_ref; is_deeply( $union_ref, \@pred, "Got expected union"); @pred = qw(baker camera delta edward fargo golfer hilton icon); @shared = $lcm->get_shared; is_deeply( \@shared, \@pred, "Got expected shared"); $shared_ref = $lcm->get_shared_ref; is_deeply( $shared_ref, \@pred, "Got expected shared"); @pred = qw(fargo golfer); @intersection = $lcm->get_intersection; is_deeply(\@intersection, \@pred, "Got expected intersection"); $intersection_ref = $lcm->get_intersection_ref; is_deeply($intersection_ref, \@pred, "Got expected intersection"); @pred = qw( jerky ); @unique = $lcm->get_unique(2); is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lcm->get_unique_ref(2); is_deeply($unique_ref, \@pred, "Got expected unique"); eval { $unique_ref = $lcm->get_unique_ref('jerky') }; like($@, qr/Argument to method List::Compare::Multiple::Accelerated::get_unique_ref must be the array index/, "Got expected error message" ); { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Lonly(2); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Lonly_ref(2); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Aonly(2); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Aonly_ref(2); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } @pred = qw( abel ); @unique = $lcm->get_unique; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lcm->get_unique_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Lonly(); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Lonly_ref(); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Aonly(); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Aonly_ref(); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } @pred = ( [ 'abel' ], [ ], [ 'jerky' ], [ ], [ ], ); $unique_all_ref = $lcm->get_unique_all(); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_unique_all()"); @pred = qw( abel icon jerky ); @complement = $lcm->get_complement(1); is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lcm->get_complement_ref(1); is_deeply($complement_ref, \@pred, "Got expected complement"); eval { $complement_ref = $lcm->get_complement_ref('jerky') }; like($@, qr/Argument to method List::Compare::Multiple::Accelerated::get_complement_ref must be the array index/, "Got expected error message" ); { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Ronly(1); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Ronly_ref(1); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Bonly(1); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Bonly_ref(1); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } @pred = qw ( hilton icon jerky ); @complement = $lcm->get_complement; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lcm->get_complement_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Ronly(); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Ronly_ref(); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Bonly(); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Bonly_ref(); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } @pred = qw( abel jerky ); @symmetric_difference = $lcm->get_symmetric_difference; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lcm->get_symmetric_difference_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lcm->get_symdiff; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lcm->get_symdiff_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); { my ($rv, $stdout, $stderr); capture( sub { @symmetric_difference = $lcm->get_LorRonly; }, \$stdout, \$stderr, ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcm->get_LorRonly_ref; }, \$stdout, \$stderr, ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @symmetric_difference = $lcm->get_AorBonly; }, \$stdout, \$stderr, ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcm->get_AorBonly_ref; }, \$stdout, \$stderr, ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly_ref or its alias defaults/, "Got expected warning", ); } %seen = (); @pred = ( [ qw( hilton icon jerky ) ], [ qw( abel icon jerky ) ], [ qw( abel baker camera delta edward ) ], [ qw( abel baker camera delta edward jerky ) ], [ qw( abel baker camera delta edward jerky ) ], ); $complement_all_ref = $lcm->get_complement_all(); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); @pred = qw( abel baker camera delta edward hilton icon jerky ); @nonintersection = $lcm->get_nonintersection; is_deeply( \@nonintersection, \@pred, "Got expected nonintersection"); $nonintersection_ref = $lcm->get_nonintersection_ref; is_deeply($nonintersection_ref, \@pred, "Got expected nonintersection"); @pred = qw( abel abel baker baker camera camera delta delta delta edward edward fargo fargo fargo fargo fargo fargo golfer golfer golfer golfer golfer hilton hilton hilton hilton icon icon icon icon icon jerky ); @bag = $lcm->get_bag; is_deeply(\@bag, \@pred, "Got expected bag"); $bag_ref = $lcm->get_bag_ref; is_deeply($bag_ref, \@pred, "Got expected bag"); $LR = $lcm->is_LsubsetR(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcm->is_AsubsetB(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcm->is_LsubsetR(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcm->is_AsubsetB(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcm->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); eval { $LR = $lcm->is_LsubsetR(2) }; like($@, qr/Method.*?requires 2 arguments/, "Got expected error message" ); eval { $LR = $lcm->is_LsubsetR(8,9) }; like($@, qr/Each argument to method.*?must be a valid array index /, "Got expected error message" ); { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcm->is_RsubsetL; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcm->is_BsubsetA; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } $eqv = $lcm->is_LequivalentR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcm->is_LeqvlntR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcm->is_LequivalentR(2,4); ok(! $eqv, "Got expected equivalence relationship"); eval { $eqv = $lcm->is_LequivalentR(2) }; like($@, qr/Method List::Compare::Multiple::Accelerated::is_LequivalentR requires 2 arguments/, "Got expected error message", ); eval { $eqv = $lcm->is_LequivalentR(8,9) }; like($@, qr/Each argument to method List::Compare::Multiple::Accelerated::is_LequivalentR must be a valid array index/, "Got expected error message", ); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcm->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcm->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); is_deeply( all_is_member_which( $lcm, \@args), $test_member_which_mult, "is_member_which() returned all expected values"); eval { $memb_arr_ref = $lcm->is_member_which('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which() correctly generated error message"); is_deeply( all_is_member_which_ref( $lcm, \@args), $test_member_which_mult, "is_member_which_ref() returned all expected values"); eval { $memb_arr_ref = $lcm->is_member_which_ref('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which_ref() correctly generated error message"); $memb_hash_ref = $lcm->are_members_which( \@args ); is_deeply($memb_hash_ref, $test_members_which_mult, "are_members_which() returned all expected values"); eval { $memb_hash_ref = $lcm->are_members_which( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_which() correctly generated error message"); is_deeply( all_is_member_any( $lcm, \@args), $test_member_any_mult, "is_member_which() returned all expected values"); eval { $lcm->is_member_any('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_any() correctly generated error message"); $memb_hash_ref = $lcm->are_members_any( \@args ); ok(wrap_are_members_any( $memb_hash_ref, $test_members_any_mult, ), "are_members_any() returned all expected values"); eval { $memb_hash_ref = $lcm->are_members_any( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_any() correctly generated error message"); $vers = $lcm->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lcm_dj = List::Compare->new('-a', \%h0, \%h1, \%h2, \%h3, \%h4, \%h8); ok($lcm_dj, "Constructor returned true value"); $disj = $lcm_dj->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); $disj = $lcm_dj->is_LdisjointR(2,3); ok(! $disj, "Got expected disjoint relationship"); $disj = $lcm_dj->is_LdisjointR(4,5); ok($disj, "Got expected disjoint relationship"); eval { $disj = $lcm_dj->is_LdisjointR(2) }; like($@, qr/Method List::Compare::Multiple::Accelerated::is_LdisjointR requires 2 arguments/, "Got expected error message"); ########## BELOW: Testfor bad arguments to constructor ########## my ($lcm_bad); my $scalar = 'test'; eval { $lcm_bad = List::Compare->new('-a', \$scalar, \%h0, \%h1) }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); List-Compare-0.53/t/35_func_lists_mult_sorted.t0000755000175000017500000002215212465263760021321 0ustar jkeenanjkeenan# perl #$Id$ # 35_func_lists_mult_sorted.t use strict; use Test::More tests => 51; use List::Compare::Functional qw(:originals :aliases); use lib ("./t"); use Test::ListCompareSpecial qw( :seen :func_wrap :arrays :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref); my @args; @pred = qw(abel baker camera delta edward fargo golfer hilton icon jerky); @union = get_union( [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); is_deeply( \@union, \@pred, "Got expected union"); $union_ref = get_union_ref( [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); is_deeply( $union_ref, \@pred, "Got expected union"); @pred = qw(baker camera delta edward fargo golfer hilton icon); @shared = get_shared( [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); is_deeply( \@shared, \@pred, "Got expected shared"); $shared_ref = get_shared_ref( [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); is_deeply( $shared_ref, \@pred, "Got expected shared"); @pred = qw(fargo golfer); @intersection = get_intersection( [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); is_deeply(\@intersection, \@pred, "Got expected intersection"); $intersection_ref = get_intersection_ref( [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); is_deeply($intersection_ref, \@pred, "Got expected intersection"); @pred = qw( jerky ); @unique = get_unique( [ \@a0, \@a1, \@a2, \@a3, \@a4 ], [ 2 ] ); is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = get_unique_ref( [ \@a0, \@a1, \@a2, \@a3, \@a4 ], [ 2 ] ); is_deeply($unique_ref, \@pred, "Got expected unique"); eval { $unique_ref = get_unique_ref( [ \@a0, \@a1, \@a2, \@a3, \@a4 ], [ 2 ], [ 'foobar' ] ); }; like($@, qr/Subroutine call requires 1 or 2 references as arguments/, "Got expected message for too many arguments"); @pred = qw( abel ); @unique = get_unique( [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = get_unique_ref( [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); is_deeply($unique_ref, \@pred, "Got expected unique"); @pred = ( [ 'abel' ], [ ], [ 'jerky' ], [ ], [ ], ); $unique_all_ref = get_unique_all( [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); is_deeply($unique_all_ref, [ @pred ], "Got expected values for get_unique_all()"); @pred = qw( abel icon jerky ); @complement = get_complement([ \@a0, \@a1, \@a2, \@a3, \@a4 ], [ 1 ] ); is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = get_complement_ref([ \@a0, \@a1, \@a2, \@a3, \@a4 ], [ 1 ] ); is_deeply($complement_ref, \@pred, "Got expected complement"); @pred = qw ( hilton icon jerky ); @complement = get_complement( [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = get_complement_ref( [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); is_deeply($complement_ref, \@pred, "Got expected complement"); eval { $complement_ref = get_complement_ref( [ \@a0, \@a1, \@a2, \@a3, \@a4 ], [ 2 ], [ 'foobar' ] ); }; like($@, qr/Subroutine call requires 1 or 2 references as arguments/, "Got expected message for too many arguments"); @pred = ( [ qw( hilton icon jerky ) ], [ qw( abel icon jerky ) ], [ qw( abel baker camera delta edward ) ], [ qw( abel baker camera delta edward jerky ) ], [ qw( abel baker camera delta edward jerky ) ], ); $complement_all_ref = get_complement_all( [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); is_deeply($complement_all_ref, [ @pred ], "Got expected values for get_complement_all()"); @pred = qw( abel jerky ); @symmetric_difference = get_symmetric_difference( [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = get_symmetric_difference_ref( [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = get_symdiff( [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = get_symdiff_ref( [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @pred = qw( abel baker camera delta edward hilton icon jerky ); @nonintersection = get_nonintersection( [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); is_deeply( \@nonintersection, \@pred, "Got expected nonintersection"); $nonintersection_ref = get_nonintersection_ref( [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); is_deeply($nonintersection_ref, \@pred, "Got expected nonintersection"); @pred = qw( abel abel baker baker camera camera delta delta delta edward edward fargo fargo fargo fargo fargo fargo golfer golfer golfer golfer golfer hilton hilton hilton hilton icon icon icon icon icon jerky ); @bag = get_bag( [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); is_deeply(\@bag, \@pred, "Got expected bag"); $bag_ref = get_bag_ref( [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); is_deeply($bag_ref, \@pred, "Got expected bag"); $LR = is_LsubsetR( [ \@a0, \@a1, \@a2, \@a3, \@a4 ], [ 3,2 ] ); ok($LR, "Got expected subset relationship"); $LR = is_LsubsetR( [ \@a0, \@a1, \@a2, \@a3, \@a4 ], [ 2,3 ] ); ok(! $LR, "Got expected subset relationship"); $LR = is_LsubsetR( [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); ok(! $LR, "Got expected subset relationship"); eval { $LR = is_LsubsetR( [ \@a0, \@a1, \@a2, \@a3, \@a4 ], [ 3,2 ], [ 'bogus' ] ); }; like($@, qr/Subroutine call requires 1 or 2 references as arguments/, "Got expected error message concerning too many arguments"); eval { $LR = is_LsubsetR( [ \@a0, \@a1, \@a2, \@a3, \@a4 ], [ 'bogus' , 2 ] ); }; like($@, qr/No element in index position/, "Got expected error message concerning bad arguments"); $eqv = is_LequivalentR( [ \@a0, \@a1, \@a2, \@a3, \@a4 ], [ 3,4 ] ); ok($eqv, "Got expected equivalence relationship"); $eqv = is_LeqvlntR( [ \@a0, \@a1, \@a2, \@a3, \@a4 ], [ 3,4 ] ); ok($eqv, "Got expected equivalence relationship"); $eqv = is_LequivalentR( [ \@a0, \@a1, \@a2, \@a3, \@a4 ], [ 2,4 ] ); ok(! $eqv, "Got expected equivalence relationship"); eval { $LR = is_LequivalentR( [ \@a0, \@a1, \@a2, \@a3, \@a4 ], [ 3,2 ], [ 'bogus' ] ); }; like($@, qr/Subroutine call requires 1 or 2 references as arguments/, "Got expected error message concerning too many arguments"); eval { $LR = is_LequivalentR( [ \@a0, \@a1, \@a2, \@a3, \@a4 ], [ 'bogus', 2 ] ); }; like($@, qr/No element in index position/, "Got expected error message concerning bad arguments"); { my ($rv, $stdout, $stderr); capture( sub { $rv = print_subset_chart( [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = print_equivalence_chart( [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); is_deeply(func_all_is_member_which( [ \@a0, \@a1, \@a2, \@a3, \@a4 ], \@args ), $test_member_which_mult, "is_member_which() returned all expected values"); is_deeply(func_all_is_member_which_ref( [ \@a0, \@a1, \@a2, \@a3, \@a4 ], \@args ), $test_member_which_mult, "is_member_which_ref() returned all expected values"); $memb_hash_ref = are_members_which( [ \@a0, \@a1, \@a2, \@a3, \@a4 ], \@args ); is_deeply($memb_hash_ref, $test_members_which_mult, "are_members_which() returned all expected values"); is_deeply(func_all_is_member_any( [ \@a0, \@a1, \@a2, \@a3, \@a4 ], \@args ), $test_member_any_mult, "is_member_any() returned all expected values"); $memb_hash_ref = are_members_any( [ \@a0, \@a1, \@a2, \@a3, \@a4 ], \@args ); ok(func_wrap_are_members_any( $memb_hash_ref, $test_members_any_mult, ), "are_members_any() returned all expected values"); $vers = get_version; ok($vers, "get_version() returned true value"); $disj = is_LdisjointR( [ \@a0, \@a1, \@a2, \@a3, \@a4, \@a8 ] ); ok(! $disj, "Got expected disjoint relationship"); $disj = is_LdisjointR( [ \@a0, \@a1, \@a2, \@a3, \@a4, \@a8 ], [ 2,3 ] ); ok(! $disj, "Got expected disjoint relationship"); $disj = is_LdisjointR( [ \@a0, \@a1, \@a2, \@a3, \@a4, \@a8 ], [ 4,5 ] ); ok($disj, "Got expected disjoint relationship"); eval { $LR = is_LdisjointR( [ \@a0, \@a1, \@a2, \@a3, \@a4 ], [ 3,2 ], [ 'bogus' ] ); }; like($@, qr/Subroutine call requires 1 or 2 references as arguments/, "Got expected error message concerning too many arguments"); eval { $LR = is_LdisjointR( [ \@a0, \@a1, \@a2, \@a3, \@a4 ], [ 'bogus', 2 ] ); }; like($@, qr/No element in index position/, "Got expected error message concerning bad arguments"); List-Compare-0.53/t/24_oo_hashes_mult_acc_unsorted.t0000755000175000017500000004361012465263760022271 0ustar jkeenanjkeenan# perl #$Id$ # 24_oo_hashes_mult_acc_unsorted.t use strict; use Test::More tests => 111; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :hashes :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; ### new ### my $lcmu = List::Compare->new('-u', '-a', \%h0, \%h1, \%h2, \%h3, \%h4); ok($lcmu, "List::Compare constructor returned true value"); %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton icon jerky ); @unpred = qw| kappa |; @union = $lcmu->get_union; $seen{$_}++ foreach (@union); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); $union_ref = $lcmu->get_union_ref; $seen{$_}++ foreach (@{$union_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer hilton icon ); @unpred = qw| abel jerky |; @shared = $lcmu->get_shared; $seen{$_}++ foreach (@shared); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); $shared_ref = $lcmu->get_shared_ref; $seen{$_}++ foreach (@{$shared_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( fargo golfer ); @unpred = qw| abel baker camera delta edward hilton icon jerky |; @intersection = $lcmu->get_intersection; $seen{$_}++ foreach (@intersection); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); $intersection_ref = $lcmu->get_intersection_ref; $seen{$_}++ foreach (@{$intersection_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( jerky ); @unpred = qw| abel baker camera delta edward fargo golfer hilton icon |; @unique = $lcmu->get_unique(2); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcmu->get_unique_ref(2); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @unique = $lcmu->get_Lonly(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $unique_ref = $lcmu->get_Lonly_ref(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { @unique = $lcmu->get_Aonly(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $unique_ref = $lcmu->get_Aonly_ref(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); @pred = ( [ 'abel' ], [ ], [ 'jerky' ], [ ], [ ], ); $unique_all_ref = $lcmu->get_unique_all(); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_unique_all()"); %pred = map {$_, 1} qw( abel icon jerky ); @unpred = qw| baker camera delta edward fargo golfer hilton |; @complement = $lcmu->get_complement(1); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcmu->get_complement_ref(1); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @complement = $lcmu->get_Bonly(1); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $complement_ref = $lcmu->get_Bonly_ref(1); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); %pred = map {$_, 1} qw( hilton icon jerky ); @unpred = qw| abel baker camera delta edward fargo golfer |; @complement = $lcmu->get_complement; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcmu->get_complement_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @complement = $lcmu->get_Ronly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $complement_ref = $lcmu->get_Ronly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { @complement = $lcmu->get_Bonly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $complement_ref = $lcmu->get_Bonly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); %pred = map {$_, 1} qw( abel jerky ); @unpred = qw| baker camera delta edward fargo golfer hilton icon |; @symmetric_difference = $lcmu->get_symmetric_difference; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcmu->get_symmetric_difference_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcmu->get_symdiff; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcmu->get_symdiff_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @symmetric_difference = $lcmu->get_LorRonly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } %seen = (); { my ($stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcmu->get_LorRonly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); } %seen = (); { my ($stdout, $stderr); capture( sub { @symmetric_difference = $lcmu->get_AorBonly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } %seen = (); { my ($stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcmu->get_AorBonly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); } %seen = (); @pred = ( [ qw( hilton icon jerky ) ], [ qw( abel icon jerky ) ], [ qw( abel baker camera delta edward ) ], [ qw( abel baker camera delta edward jerky ) ], [ qw( abel baker camera delta edward jerky ) ], ); $complement_all_ref = $lcmu->get_complement_all(); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %pred = map {$_, 1} qw( abel baker camera delta edward hilton icon jerky ); @unpred = qw| fargo golfer |; @nonintersection = $lcmu->get_nonintersection; $seen{$_}++ foreach (@nonintersection); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); $nonintersection_ref = $lcmu->get_nonintersection_ref; $seen{$_}++ foreach (@{$nonintersection_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); %pred = ( abel => 2, baker => 2, camera => 2, delta => 3, edward => 2, fargo => 6, golfer => 5, hilton => 4, icon => 5, jerky => 1, ); @unpred = qw| kappa |; @bag = $lcmu->get_bag; $seen{$_}++ foreach (@bag); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $bag_ref = $lcmu->get_bag_ref; $seen{$_}++ foreach (@{$bag_ref}); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $LR = $lcmu->is_LsubsetR(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcmu->is_AsubsetB(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcmu->is_LsubsetR(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcmu->is_AsubsetB(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcmu->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcmu->is_RsubsetL; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcmu->is_BsubsetA; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } $eqv = $lcmu->is_LequivalentR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcmu->is_LeqvlntR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcmu->is_LequivalentR(2,4); ok(! $eqv, "Got expected equivalence relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcmu->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcmu->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); is_deeply( all_is_member_which( $lcmu, \@args), $test_member_which_mult, "is_member_which() returned all expected values"); is_deeply( all_is_member_which_ref( $lcmu, \@args), $test_member_which_mult, "is_member_which_ref() returned all expected values"); $memb_hash_ref = $lcmu->are_members_which( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); is_deeply($memb_hash_ref, $test_members_which_mult, "are_members_which() returned all expected values"); is_deeply( all_is_member_any( $lcmu, \@args), $test_member_any_mult, "is_member_which() returned all expected values"); $memb_hash_ref = $lcmu->are_members_any( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); is_deeply($memb_hash_ref, $test_members_any_mult, "are_members_any() returned all expected values"); $vers = $lcmu->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lcmu_dj = List::Compare->new('-u', '-a', \%h0, \%h1, \%h2, \%h3, \%h4, \%h8); ok($lcmu_dj, "List::Compare constructor returned true value"); $disj = $lcmu_dj->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); $disj = $lcmu_dj->is_LdisjointR(2,3); ok(! $disj, "Got expected disjoint relationship"); $disj = $lcmu_dj->is_LdisjointR(4,5); ok($disj, "Got expected disjoint relationship"); ########## BELOW: Test for '--unsorted' option ########## my $lcmuna = List::Compare->new( '--unsorted', '-a', \%h0, \%h1, \%h2, \%h3, \%h4); ok($lcmuna, "List::Compare constructor returned true value"); $lcmuna = List::Compare->new( '--unsorted', '--accelerated', \%h0, \%h1, \%h2, \%h3, \%h4); ok($lcmuna, "List::Compare constructor returned true value"); List-Compare-0.53/t/17_oo_hashes_dual_reg_sorted.t0000755000175000017500000002325712465263760021730 0ustar jkeenanjkeenan# perl #$Id$ # 17_oo_hashes_dual_reg_sorted.t use strict; use Test::More tests => 76; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :hashes :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref); my @args; ### new ### my $lc = List::Compare->new(\%h0, \%h1); ok($lc, "List::Compare constructor returned true value"); @pred = qw(abel baker camera delta edward fargo golfer hilton); @union = $lc->get_union; is_deeply( \@union, \@pred, "Got expected union"); $union_ref = $lc->get_union_ref; is_deeply( $union_ref, \@pred, "Got expected union"); @pred = qw( baker camera delta edward fargo golfer ); @intersection = $lc->get_intersection; is_deeply(\@intersection, \@pred, "Got expected intersection"); $intersection_ref = $lc->get_intersection_ref; is_deeply($intersection_ref, \@pred, "Got expected intersection"); { my ($rv, $stdout, $stderr); capture( sub { @shared = $lc->get_shared; }, \$stdout, \$stderr, ); is_deeply( \@shared, \@pred, "Got expected shared"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } { my ($rv, $stdout, $stderr); capture( sub { $shared_ref = $lc->get_shared_ref; }, \$stdout, \$stderr, ); is_deeply( $shared_ref, \@pred, "Got expected shared"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } @pred = qw( abel ); @unique = $lc->get_unique; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lc->get_unique_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); @unique = $lc->get_Lonly; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lc->get_Lonly_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); @unique = $lc->get_Aonly; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lc->get_Aonly_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); @pred = ( [ 'abel' ], [ 'hilton' ], ); $unique_all_ref = $lc->get_unique_all(); is_deeply($unique_all_ref, [ @pred ], "Got expected values for get_unique_all()"); @pred = qw ( hilton ); @complement = $lc->get_complement; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lc->get_complement_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); @complement = $lc->get_Ronly; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lc->get_Ronly_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); @complement = $lc->get_Bonly; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lc->get_Bonly_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); @pred = ( [ qw( hilton ) ], [ qw( abel ) ], ); $complement_all_ref = $lc->get_complement_all(); is_deeply($complement_all_ref, [ @pred ], "Got expected values for get_complement_all()"); @pred = qw( abel hilton ); @symmetric_difference = $lc->get_symmetric_difference; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_symmetric_difference_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lc->get_symdiff; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_symdiff_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lc->get_LorRonly; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_LorRonly_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lc->get_AorBonly; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_AorBonly_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @pred = qw( abel hilton ); { my ($rv, $stdout, $stderr); capture( sub { @nonintersection = $lc->get_nonintersection; }, \$stdout, \$stderr, ); is_deeply( \@nonintersection, \@pred, "Got expected nonintersection"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } { my ($rv, $stdout, $stderr); capture( sub { $nonintersection_ref = $lc->get_nonintersection_ref; }, \$stdout, \$stderr, ); is_deeply($nonintersection_ref, \@pred, "Got expected nonintersection"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } @pred = qw( abel abel baker baker camera camera delta delta delta edward edward fargo fargo golfer golfer hilton ); @bag = $lc->get_bag; is_deeply(\@bag, \@pred, "Got expected bag"); $bag_ref = $lc->get_bag_ref; is_deeply($bag_ref, \@pred, "Got expected bag"); $LR = $lc->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); $LR = $lc->is_AsubsetB; ok(! $LR, "Got expected subset relationship"); $RL = $lc->is_RsubsetL; ok(! $RL, "Got expected subset relationship"); $RL = $lc->is_BsubsetA; ok(! $RL, "Got expected subset relationship"); $eqv = $lc->is_LequivalentR; ok(! $eqv, "Got expected equivalent relationship"); $eqv = $lc->is_LeqvlntR; ok(! $eqv, "Got expected equivalent relationship"); $disj = $lc->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lc->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lc->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } ok(wrap_is_member_which( $lc, $test_members_which, ), "is_member_which() returned all expected values"); eval { $memb_arr_ref = $lc->is_member_which('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which() correctly generated error message"); ok(wrap_is_member_which_ref( $lc, $test_members_which, ), "is_member_which_ref() returned all expected values"); eval { $memb_arr_ref = $lc->is_member_which_ref('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which_ref() correctly generated error message"); @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); $memb_hash_ref = $lc->are_members_which( \@args ); ok(wrap_are_members_which( $memb_hash_ref, $test_members_which, ), "are_members_which() returned all expected value"); eval { $memb_hash_ref = $lc->are_members_which( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_which() correctly generated error message"); ok(wrap_is_member_any( $lc, $test_members_any, ), "is_member_any() returned all expected values"); eval { $lc->is_member_any('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_any() correctly generated error message"); $memb_hash_ref = $lc->are_members_any( \@args ); ok(wrap_are_members_any( $memb_hash_ref, $test_members_any, ), "are_members_any() returned all expected values"); eval { $memb_hash_ref = $lc->are_members_any( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_any() correctly generated error message"); $vers = $lc->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lc_s = List::Compare->new(\%h2, \%h3); ok($lc_s, "constructor returned true value"); $LR = $lc_s->is_LsubsetR; ok(! $LR, "non-subset correctly determined"); $LR = $lc_s->is_AsubsetB; ok(! $LR, "non-subset correctly determined"); $RL = $lc_s->is_RsubsetL; ok($RL, "subset correctly determined"); $RL = $lc_s->is_BsubsetA; ok($RL, "subset correctly determined"); $eqv = $lc_s->is_LequivalentR; ok(! $eqv, "non-equivalence correctly determined"); $eqv = $lc_s->is_LeqvlntR; ok(! $eqv, "non-equivalence correctly determined"); $disj = $lc_s->is_LdisjointR; ok(! $disj, "non-disjoint correctly determined"); ### new ### my $lc_e = List::Compare->new(\%h3, \%h4); ok($lc_e, "constructor returned true value"); $eqv = $lc_e->is_LequivalentR; ok($eqv, "equivalence correctly determined"); $eqv = $lc_e->is_LeqvlntR; ok($eqv, "equivalence correctly determined"); $disj = $lc_e->is_LdisjointR; ok(! $disj, "non-disjoint correctly determined"); ### new ### my $lc_dj = List::Compare->new(\%h4, \%h8); ok($lc_dj, "constructor returned true value"); ok(0 == $lc_dj->get_intersection, "no intersection, as expected"); ok(0 == scalar(@{$lc_dj->get_intersection_ref}), "no intersection, as expected"); $disj = $lc_dj->is_LdisjointR; ok($disj, "disjoint correctly determined"); ########## BELOW: Test for bad arguments to constructor ########## my ($lc_bad); eval { $lc_bad = List::Compare->new(\%h0) }; like($@, qr/^Need to pass references to 2 or more seen-hashes/s, "Got expected error message from bad constructor"); List-Compare-0.53/t/13_oo_lists_alt_mult_reg_sorted.t0000755000175000017500000004222712465263760022501 0ustar jkeenanjkeenan# perl #$Id$ # t/13_oo_lists_alt_mult_reg_sorted.t use strict; use Test::More tests => 106; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :arrays :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; ### new ### my $lcm = List::Compare->new( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ] } ); ok($lcm, "List::Compare constructor returned true value"); @pred = qw(abel baker camera delta edward fargo golfer hilton icon jerky); @union = $lcm->get_union; is_deeply( \@union, \@pred, "Got expected union"); $union_ref = $lcm->get_union_ref; is_deeply( $union_ref, \@pred, "Got expected union"); @pred = qw(baker camera delta edward fargo golfer hilton icon); @shared = $lcm->get_shared; is_deeply( \@shared, \@pred, "Got expected shared"); $shared_ref = $lcm->get_shared_ref; is_deeply( $shared_ref, \@pred, "Got expected shared"); @pred = qw(fargo golfer); @intersection = $lcm->get_intersection; is_deeply(\@intersection, \@pred, "Got expected intersection"); $intersection_ref = $lcm->get_intersection_ref; is_deeply($intersection_ref, \@pred, "Got expected intersection"); @pred = qw( jerky ); @unique = $lcm->get_unique(2); is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lcm->get_unique_ref(2); is_deeply($unique_ref, \@pred, "Got expected unique"); eval { $unique_ref = $lcm->get_unique_ref('jerky') }; like($@, qr/Argument to method List::Compare::Multiple::get_unique_ref must be the array index/, "Got expected error message" ); { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Lonly(2); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Lonly_ref(2); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Aonly(2); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Aonly_ref(2); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } @pred = qw( abel ); @unique = $lcm->get_unique; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lcm->get_unique_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Lonly(); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Lonly_ref(); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Aonly(); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Aonly_ref(); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } @pred = ( [ 'abel' ], [ ], [ 'jerky' ], [ ], [ ], ); $unique_all_ref = $lcm->get_unique_all(); is_deeply($unique_all_ref, [ @pred ], "Got expected values for get_unique_all()"); @pred = qw( abel icon jerky ); @complement = $lcm->get_complement(1); is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lcm->get_complement_ref(1); is_deeply($complement_ref, \@pred, "Got expected complement"); eval { $complement_ref = $lcm->get_complement_ref('jerky') }; like($@, qr/Argument to method List::Compare::Multiple::get_complement_ref must be the array index/, "Got expected error message" ); { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Ronly(1); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Ronly_ref(1); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Bonly(1); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Bonly_ref(1); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } @pred = qw ( hilton icon jerky ); @complement = $lcm->get_complement; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lcm->get_complement_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Ronly(); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Ronly_ref(); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Bonly(); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Bonly_ref(); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } @pred = ( [ qw( hilton icon jerky ) ], [ qw( abel icon jerky ) ], [ qw( abel baker camera delta edward ) ], [ qw( abel baker camera delta edward jerky ) ], [ qw( abel baker camera delta edward jerky ) ], ); $complement_all_ref = $lcm->get_complement_all(); is_deeply($complement_all_ref, [ @pred ], "Got expected values for get_complement_all()"); @pred = qw( abel jerky ); @symmetric_difference = $lcm->get_symmetric_difference; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lcm->get_symmetric_difference_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lcm->get_symdiff; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lcm->get_symdiff_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); { my ($rv, $stdout, $stderr); capture( sub { @symmetric_difference = $lcm->get_LorRonly; }, \$stdout, \$stderr, ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcm->get_LorRonly_ref; }, \$stdout, \$stderr, ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @symmetric_difference = $lcm->get_AorBonly; }, \$stdout, \$stderr, ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcm->get_AorBonly_ref; }, \$stdout, \$stderr, ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly_ref or its alias defaults/, "Got expected warning", ); } @pred = qw( abel baker camera delta edward hilton icon jerky ); @nonintersection = $lcm->get_nonintersection; is_deeply( \@nonintersection, \@pred, "Got expected nonintersection"); $nonintersection_ref = $lcm->get_nonintersection_ref; is_deeply($nonintersection_ref, \@pred, "Got expected nonintersection"); @pred = qw( abel abel baker baker camera camera delta delta delta edward edward fargo fargo fargo fargo fargo fargo golfer golfer golfer golfer golfer hilton hilton hilton hilton icon icon icon icon icon jerky ); @bag = $lcm->get_bag; is_deeply(\@bag, \@pred, "Got expected bag"); $bag_ref = $lcm->get_bag_ref; is_deeply($bag_ref, \@pred, "Got expected bag"); $LR = $lcm->is_LsubsetR(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcm->is_AsubsetB(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcm->is_LsubsetR(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcm->is_AsubsetB(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcm->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); eval { $LR = $lcm->is_LsubsetR(2) }; like($@, qr/Method List::Compare::Multiple::is_LsubsetR requires 2 arguments/, "Got expected error message" ); eval { $LR = $lcm->is_LsubsetR(8,9) }; like($@, qr/Each argument to method List::Compare::Multiple::is_LsubsetR must be a valid array index /, "Got expected error message" ); { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcm->is_RsubsetL; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcm->is_BsubsetA; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } $eqv = $lcm->is_LequivalentR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcm->is_LeqvlntR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcm->is_LequivalentR(2,4); ok(! $eqv, "Got expected equivalence relationship"); eval { $eqv = $lcm->is_LequivalentR(2) }; like($@, qr/Method List::Compare::Multiple::is_LequivalentR requires 2 arguments/, "Got expected error message", ); eval { $eqv = $lcm->is_LequivalentR(8,9) }; like($@, qr/Each argument to method List::Compare::Multiple::is_LequivalentR must be a valid array index/, "Got expected error message", ); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcm->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcm->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); is_deeply( all_is_member_which( $lcm, \@args), $test_member_which_mult, "is_member_which() returned all expected values"); eval { $memb_arr_ref = $lcm->is_member_which('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which() correctly generated error message"); is_deeply( all_is_member_which_ref( $lcm, \@args), $test_member_which_mult, "is_member_which_ref() returned all expected values"); eval { $memb_arr_ref = $lcm->is_member_which_ref('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which_ref() correctly generated error message"); $memb_hash_ref = $lcm->are_members_which( \@args ); is_deeply($memb_hash_ref, $test_members_which_mult, "are_members_which() returned all expected values"); eval { $memb_hash_ref = $lcm->are_members_which( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_which() correctly generated error message"); is_deeply( all_is_member_any( $lcm, \@args), $test_member_any_mult, "is_member_which() returned all expected values"); eval { $lcm->is_member_any('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_any() correctly generated error message"); $memb_hash_ref = $lcm->are_members_any( \@args ); ok(wrap_are_members_any( $memb_hash_ref, $test_members_any_mult, ), "are_members_any() returned all expected values"); eval { $memb_hash_ref = $lcm->are_members_any( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_any() correctly generated error message"); $vers = $lcm->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lcm_dj = List::Compare->new( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4, \@a8 ] } ); ok($lcm_dj, "Constructor returned true value"); $disj = $lcm_dj->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); $disj = $lcm_dj->is_LdisjointR(2,3); ok(! $disj, "Got expected disjoint relationship"); $disj = $lcm_dj->is_LdisjointR(4,5); ok($disj, "Got expected disjoint relationship"); eval { $disj = $lcm_dj->is_LdisjointR(2) }; like($@, qr/Method List::Compare::Multiple::is_LdisjointR requires 2 arguments/, "Got expected error message"); ########## BELOW: Testfor bad arguments to constructor ########## my ($lcm_bad); my %h5 = ( golfer => 1, lambda => 0, ); eval { $lcm_bad = List::Compare->new( { lists => [ \@a0, \@a1, \@a2, \@a3, \%h5 ], } ); }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); eval { $lcm_bad = List::Compare->new( { lists => [ \%h5, \@a0, \@a1, \@a2, \@a3 ], } ); }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); my $scalar = 'test'; eval { $lcm_bad = List::Compare->new( { lists => [ \$scalar, \@a0, \@a1 ] } ); }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); List-Compare-0.53/t/36_func_lists_mult_unsorted.t0000755000175000017500000002032412470375301021653 0ustar jkeenanjkeenan# perl #$Id$ # 36_func_lists_mult_unsorted.t use strict; use Test::More tests => 42; use List::Compare::Functional qw(:originals :aliases); use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :arrays :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton icon jerky ); @unpred = qw| kappa |; @union = get_union( '-u', [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); $seen{$_}++ foreach (@union); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); $union_ref = get_union_ref( '-u', [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); $seen{$_}++ foreach (@{$union_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer hilton icon ); @unpred = qw| abel jerky |; @shared = get_shared( '-u', [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); $seen{$_}++ foreach (@shared); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); $shared_ref = get_shared_ref( '-u', [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); $seen{$_}++ foreach (@{$shared_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( fargo golfer ); @unpred = qw| abel baker camera delta edward hilton icon jerky |; @intersection = get_intersection( '-u', [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); $seen{$_}++ foreach (@intersection); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); $intersection_ref = get_intersection_ref( '-u', [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); $seen{$_}++ foreach (@{$intersection_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( jerky ); @unpred = qw| abel baker camera delta edward fargo golfer hilton icon |; @unique = get_unique( '-u', [ \@a0, \@a1, \@a2, \@a3, \@a4 ], [ 2 ] ); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = get_unique_ref( '-u', [ \@a0, \@a1, \@a2, \@a3, \@a4 ], [ 2 ] ); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ 'abel' ], [ ], [ 'jerky' ], [ ], [ ], ); $unique_all_ref = get_unique_all( '-u', [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %pred = map {$_, 1} qw( abel icon jerky ); @unpred = qw| baker camera delta edward fargo golfer hilton |; @complement = get_complement( '-u', [ \@a0, \@a1, \@a2, \@a3, \@a4 ], [ 1 ] ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = get_complement_ref( '-u', [ \@a0, \@a1, \@a2, \@a3, \@a4 ], [ 1 ] ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( hilton icon jerky ); @unpred = qw| abel baker camera delta edward fargo golfer |; @complement = get_complement( '-u', [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = get_complement_ref( '-u', [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel jerky ); @unpred = qw| baker camera delta edward fargo golfer hilton icon |; @symmetric_difference = get_symmetric_difference( '-u', [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = get_symmetric_difference_ref( '-u', [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = get_symdiff( '-u', [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = get_symdiff_ref( '-u', [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ qw( hilton icon jerky ) ], [ qw( abel icon jerky ) ], [ qw( abel baker camera delta edward ) ], [ qw( abel baker camera delta edward jerky ) ], [ qw( abel baker camera delta edward jerky ) ], ); $complement_all_ref = get_complement_all( '-u', [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %seen = (); %pred = map {$_, 1} qw( abel baker camera delta edward hilton icon jerky ); @unpred = qw| fargo golfer |; @nonintersection = get_nonintersection( '-u', [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); $seen{$_}++ foreach (@nonintersection); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); $nonintersection_ref = get_nonintersection_ref( '-u', [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); $seen{$_}++ foreach (@{$nonintersection_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); %pred = ( abel => 2, baker => 2, camera => 2, delta => 3, edward => 2, fargo => 6, golfer => 5, hilton => 4, icon => 5, jerky => 1, ); @unpred = qw| kappa |; @bag = get_bag( '-u', [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); $seen{$_}++ foreach (@bag); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $bag_ref = get_bag_ref( '-u', [ \@a0, \@a1, \@a2, \@a3, \@a4 ] ); $seen{$_}++ foreach (@{$bag_ref}); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); List-Compare-0.53/t/01_oo_lists_dual_reg_sorted.t0000755000175000017500000002631412465531123021570 0ustar jkeenanjkeenan# perl #$Id$ # 01_oo_lists_dual_reg_sorted.t use strict; use Test::More tests => 84; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :arrays :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref); my @args; ### new ### my $lc = List::Compare->new(\@a0, \@a1); ok($lc, "List::Compare constructor returned true value"); my $alc = List::Compare->new( { lists => [ \@a0, \@a1 ] } ); is_deeply($lc, $alc, "Regular and alternative constructors produce same object"); @pred = qw(abel baker camera delta edward fargo golfer hilton); @union = $lc->get_union; is_deeply( \@union, \@pred, "Got expected union"); $union_ref = $lc->get_union_ref; is_deeply( $union_ref, \@pred, "Got expected union"); @pred = qw( baker camera delta edward fargo golfer ); @intersection = $lc->get_intersection; is_deeply(\@intersection, \@pred, "Got expected intersection"); $intersection_ref = $lc->get_intersection_ref; is_deeply($intersection_ref, \@pred, "Got expected intersection"); { my ($rv, $stdout, $stderr); capture( sub { @shared = $lc->get_shared; }, \$stdout, \$stderr, ); is_deeply( \@shared, \@pred, "Got expected shared"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } { my ($rv, $stdout, $stderr); capture( sub { $shared_ref = $lc->get_shared_ref; }, \$stdout, \$stderr, ); is_deeply( $shared_ref, \@pred, "Got expected shared"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } @pred = qw( abel ); @unique = $lc->get_unique; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lc->get_unique_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); @unique = $lc->get_Lonly; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lc->get_Lonly_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); @unique = $lc->get_Aonly; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lc->get_Aonly_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); @pred = ( [ 'abel' ], [ 'hilton' ], ); $unique_all_ref = $lc->get_unique_all(); is_deeply($unique_all_ref, [ @pred ], "Got expected values for get_unique_all()"); @pred = qw ( hilton ); @complement = $lc->get_complement; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lc->get_complement_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); @complement = $lc->get_Ronly; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lc->get_Ronly_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); @complement = $lc->get_Bonly; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lc->get_Bonly_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); @pred = ( [ qw( hilton ) ], [ qw( abel ) ], ); $complement_all_ref = $lc->get_complement_all(); is_deeply($complement_all_ref, [ @pred ], "Got expected values for get_complement_all()"); @pred = qw( abel hilton ); @symmetric_difference = $lc->get_symmetric_difference; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_symmetric_difference_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lc->get_symdiff; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_symdiff_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lc->get_LorRonly; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_LorRonly_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lc->get_AorBonly; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_AorBonly_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @pred = qw( abel hilton ); { my ($rv, $stdout, $stderr); capture( sub { @nonintersection = $lc->get_nonintersection; }, \$stdout, \$stderr, ); is_deeply( \@nonintersection, \@pred, "Got expected nonintersection"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } { my ($rv, $stdout, $stderr); capture( sub { $nonintersection_ref = $lc->get_nonintersection_ref; }, \$stdout, \$stderr, ); is_deeply($nonintersection_ref, \@pred, "Got expected nonintersection"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } @pred = qw( abel abel baker baker camera camera delta delta delta edward edward fargo fargo golfer golfer hilton ); @bag = $lc->get_bag; is_deeply(\@bag, \@pred, "Got expected bag"); $bag_ref = $lc->get_bag_ref; is_deeply($bag_ref, \@pred, "Got expected bag"); $LR = $lc->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); $LR = $lc->is_AsubsetB; ok(! $LR, "Got expected subset relationship"); $RL = $lc->is_RsubsetL; ok(! $RL, "Got expected subset relationship"); $RL = $lc->is_BsubsetA; ok(! $RL, "Got expected subset relationship"); $eqv = $lc->is_LequivalentR; ok(! $eqv, "Got expected equivalent relationship"); $eqv = $lc->is_LeqvlntR; ok(! $eqv, "Got expected equivalent relationship"); $disj = $lc->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lc->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lc->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } ok(wrap_is_member_which( $lc, $test_members_which, ), "is_member_which() returned all expected values"); eval { $memb_arr_ref = $lc->is_member_which('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which() correctly generated error message"); ok(wrap_is_member_which_ref( $lc, $test_members_which, ), "is_member_which_ref() returned all expected values"); eval { $memb_arr_ref = $lc->is_member_which_ref('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which_ref() correctly generated error message"); eval { $memb_arr_ref = $lc->is_member_which_ref( [ 'jerky' ] ) }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which_ref() correctly generated error message"); @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); $memb_hash_ref = $lc->are_members_which( \@args ); ok(wrap_are_members_which( $memb_hash_ref, $test_members_which, ), "are_members_which() returned all expected value"); eval { $memb_hash_ref = $lc->are_members_which( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_which() correctly generated error message"); eval { $memb_hash_ref = $lc->are_members_which( \@args, [ 1 .. 3 ] ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_which() correctly generated error message"); ok(wrap_is_member_any( $lc, $test_members_any, ), "is_member_any() returned all expected values"); eval { $lc->is_member_any('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_any() correctly generated error message"); eval { $lc->is_member_any( [ 'jerky' ] ) }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_any() correctly generated error message"); $memb_hash_ref = $lc->are_members_any( \@args ); ok(wrap_are_members_any( $memb_hash_ref, $test_members_any, ), "are_members_any() returned all expected values"); eval { $memb_hash_ref = $lc->are_members_any( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_any() correctly generated error message"); eval { $memb_hash_ref = $lc->are_members_any( \@args, [ 1..3 ] ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_any() correctly generated error message"); $vers = $lc->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lc_s = List::Compare->new(\@a2, \@a3); ok($lc_s, "constructor returned true value"); $LR = $lc_s->is_LsubsetR; ok(! $LR, "non-subset correctly determined"); $LR = $lc_s->is_AsubsetB; ok(! $LR, "non-subset correctly determined"); $RL = $lc_s->is_RsubsetL; ok($RL, "subset correctly determined"); $RL = $lc_s->is_BsubsetA; ok($RL, "subset correctly determined"); $eqv = $lc_s->is_LequivalentR; ok(! $eqv, "non-equivalence correctly determined"); $eqv = $lc_s->is_LeqvlntR; ok(! $eqv, "non-equivalence correctly determined"); $disj = $lc_s->is_LdisjointR; ok(! $disj, "non-disjoint correctly determined"); ### new ### my $lc_e = List::Compare->new(\@a3, \@a4); ok($lc_e, "constructor returned true value"); $eqv = $lc_e->is_LequivalentR; ok($eqv, "equivalence correctly determined"); $eqv = $lc_e->is_LeqvlntR; ok($eqv, "equivalence correctly determined"); $disj = $lc_e->is_LdisjointR; ok(! $disj, "non-disjoint correctly determined"); ### new ### my $lc_dj = List::Compare->new(\@a4, \@a8); ok($lc_dj, "constructor returned true value"); ok(0 == $lc_dj->get_intersection, "no intersection, as expected"); ok(0 == scalar(@{$lc_dj->get_intersection_ref}), "no intersection, as expected"); $disj = $lc_dj->is_LdisjointR; ok($disj, "disjoint correctly determined"); ########## BELOW: Test for bad arguments to constructor ########## my ($lc_bad); my %h5 = ( golfer => 1, lambda => 0, ); eval { $lc_bad = List::Compare->new(\@a0, \%h5) }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); eval { $lc_bad = List::Compare->new(\%h5, \@a0) }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); my $scalar = 'test'; eval { $lc_bad = List::Compare->new(\$scalar, \@a0) }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); eval { $lc_bad = List::Compare->new(\@a0) }; like($@, qr/Must pass at least 2 references/, "Got expected error message from bad constructor"); List-Compare-0.53/t/91_func_errors.t0000755000175000017500000001720512367450671017063 0ustar jkeenanjkeenan# perl #$Id$ # 91_func_errors.t use strict; use Test::More tests => 176; use List::Compare::Functional qw(:originals :aliases); use lib ("./t"); use Test::ListCompareSpecial qw( :seen :func_wrap :arrays :hashes :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref); my @args; my $error = q{--bad-string}; my %badhash1 = ( alpha => 1, beta => q{omega}, ); my %badhash2 = ( gamma => 1, delta => q{psi}, ); my $bad_lists_msg = q{If argument is single hash ref, you must have a 'lists' key whose value is an array ref}; I_class_func_tests(\&get_union, q{get_union}); I_class_func_tests(\&get_union_ref, q{get_union_ref}); I_class_func_tests(\&get_intersection, q{get_intersection}); I_class_func_tests(\&get_intersection_ref, q{get_intersection_ref}); I_class_func_tests(\&get_shared, q{get_shared}); I_class_func_tests(\&get_shared_ref, q{get_shared_ref}); I_class_func_tests(\&get_nonintersection, q{get_nonintersection}); I_class_func_tests(\&get_nonintersection_ref, q{get_nonintersection_ref}); I_class_func_tests(\&get_symmetric_difference, q{get_symmetric_difference}); I_class_func_tests(\&get_symmetric_difference_ref, q{get_symmetric_difference_ref}); I_class_func_tests(\&get_symdiff, q{get_symdiff}); I_class_func_tests(\&get_symdiff_ref, q{get_symdiff_ref}); I_class_func_tests(\&get_bag, q{get_bag}); I_class_func_tests(\&get_bag_ref, q{get_union_ref}); II_class_func_tests(\&get_unique, q{get_unique}); II_class_func_tests(\&get_unique_ref, q{get_unique_ref}); II_class_func_tests(\&get_complement, q{get_complement}); II_class_func_tests(\&get_complement_ref, q{get_complement_ref}); III_class_func_tests(\&is_LsubsetR, q{is_LsubsetR}); III_class_func_tests(\&is_RsubsetL, q{is_RsubsetL}); III_class_func_tests(\&is_LequivalentR, q{is_LequivalentR}); III_class_func_tests(\&is_LeqvlntR, q{is_LeqvlntR}); III_class_func_tests(\&is_LdisjointR, q{is_LdisjointR}); IV_class_func_tests(\&is_member_which, q{is_member_which}); IV_class_func_tests(\&is_member_which_ref, q{is_member_which_ref}); IV_class_func_tests(\&is_member_any, q{is_member_any}); V_class_func_tests(\&are_members_which, q{are_members_which}); V_class_func_tests(\&are_members_any, q{are_members_any}); sub I_class_func_tests { my $sub = shift; my $name = shift; my @results; # Assume we have access to imported globals such as @a0, %h1, etc. eval { @results = $sub->( { key => 'value' } ); }; like($@, qr/^$bad_lists_msg/, "$name: Got expected error message for bad single hash ref"); eval { @results = $sub->( { lists => 'not a reference' } ); }; like($@, qr/^$bad_lists_msg/, "$name: Got expected error message for bad single hash ref"); eval { @results = $sub->( $error, [ \@a0, \@a1 ] ); }; like($@, qr/^'$error' must be an array ref/, "$name: Got expected error message for bad non-ref argument"); eval { @results = $sub->( '-u', $error, [ \@a0, \@a1 ] ); }; like($@, qr/^'$error' must be an array ref/, "$name: Got expected error message for bad non-ref argument"); eval { @results = $sub->( [ \%h0, \@a1 ] ); }; like($@, qr/Arguments must be either all array references or all hash references/, "$name: Got expected error message for mixing array refs and hash refs"); eval { @results = $sub->( [ \%badhash1, \%badhash2 ] ); }; like($@, qr/Values in a 'seen-hash' must be numeric/s, "$name: Got expected error message for bad seen-hash"); like($@, qr/Key:\s+beta\s+Value:\s+omega/s, "$name: Got expected error message for bad seen-hash"); } sub II_class_func_tests { my $sub = shift; my $name = shift; I_class_func_tests($sub, $name); my @results; eval { @results = $sub->( $error, [ \@a0, \@a1 ], [2], [3] ); }; like($@, qr/Subroutine call requires 1 or 2 references as arguments/, "$name: Got expected error message for wrong number of arguments"); eval { @results = $sub->( $error, [ \%h0, \%h1 ], [2], [3] ); }; like($@, qr/Subroutine call requires 1 or 2 references as arguments/, "$name: Got expected error message for wrong number of arguments"); } sub III_class_func_tests { my $sub = shift; my $name = shift; my $result; # Assume we have access to imported globals such as @a0, %h1, etc. eval { $result = $sub->( { key => 'value' } ); }; like($@, qr/^$bad_lists_msg/, "$name: Got expected error message for bad single hash ref"); eval { $result = $sub->( { lists => 'not a reference' } ); }; like($@, qr/^$bad_lists_msg/, "$name: Got expected error message for bad single hash ref"); my $i = 2; eval { $result = $sub->( [ \@a0, \@a1 ], [ $i, 0 ] ); }; like($@, qr/No element in index position $i in list of list references passed as first argument to function/, "$name: Got expected error message for non-existent index position"); eval { $result = $sub->( [ \@a0, \@a1 ], [ $i ] ); }; like($@, qr/Must provide index positions corresponding to two lists/, "$name: Got expected error message for non-existent index position"); } sub IV_class_func_tests { my $sub = shift; my $name = shift; my @results; # Assume we have access to imported globals such as @a0, %h1, etc. eval { @results = $sub->( { item => 'value' } ); }; like($@, qr/^$bad_lists_msg/, "$name: Got expected error message for single hash ref lacking 'lists' key"); eval { @results = $sub->( { lists => 'not a reference' } ); }; like($@, qr/^$bad_lists_msg/, "$name: Got expected error message for bad single hash ref"); eval { @results = $sub->( { lists => [ \@a0, \@a1 ] } ); }; like($@, qr/^If argument is single hash ref, you must have an 'item' key/, "$name: Got expected error message for single hash ref lacking 'item' key"); eval { @results = $sub->( [ \@a0, \@a1 ] ); }; like($@, qr/^Subroutine call requires 2 references as arguments/, "$name: Got expected error message for lack of second argument"); } sub V_class_func_tests { my $sub = shift; my $name = shift; my $result; # Assume we have access to imported globals such as @a0, %h1, etc. eval { $result = $sub->( { items => 'value' } ); }; like($@, qr/^$bad_lists_msg/, "$name: Got expected error message for single hash ref lacking 'lists' key"); eval { $result = $sub->( { lists => 'not a reference' } ); }; like($@, qr/^$bad_lists_msg/, "$name: Got expected error message for bad single hash ref"); eval { $result = $sub->( { lists => [ \@a0, \@a1 ] } ); }; like($@, qr/^If argument is single hash ref, you must have an 'items' key/, "$name: Got expected error message for single hash ref lacking 'items' key"); eval { $result = $sub->( { lists => [ \@a0, \@a1 ], items => 'not a reference', } ); }; like($@, qr/^If argument is single hash ref, you must have an 'items' key/, "$name: Got expected error message for single hash ref with improper 'items' key"); eval { $result = $sub->( [ \@a0, \@a1 ] ); }; like($@, qr/^Subroutine call requires 2 references as arguments/, "$name: Got expected error message for lack of second argument"); } List-Compare-0.53/t/40_func_lists_alt_mult_unsorted.t0000755000175000017500000002164212465263760022523 0ustar jkeenanjkeenan# perl #$Id$ # 40_func_lists_alt_mult_unsorted.t use strict; use Test::More tests => 42; use List::Compare::Functional qw(:originals :aliases); use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :arrays :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton icon jerky ); @unpred = qw| kappa |; @union = get_union( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], unsorted => 1, } ); $seen{$_}++ foreach (@union); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); $union_ref = get_union_ref( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], unsorted => 1, } ); $seen{$_}++ foreach (@{$union_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer hilton icon ); @unpred = qw| abel jerky |; @shared = get_shared( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], unsorted => 1, } ); $seen{$_}++ foreach (@shared); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); $shared_ref = get_shared_ref( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], unsorted => 1, } ); $seen{$_}++ foreach (@{$shared_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( fargo golfer ); @unpred = qw| abel baker camera delta edward hilton icon jerky |; @intersection = get_intersection( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], unsorted => 1, } ); $seen{$_}++ foreach (@intersection); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); $intersection_ref = get_intersection_ref( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], unsorted => 1, } ); $seen{$_}++ foreach (@{$intersection_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( jerky ); @unpred = qw| abel baker camera delta edward fargo golfer hilton icon |; @unique = get_unique( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], unsorted => 1, item => 2, } ); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = get_unique_ref( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], unsorted => 1, item => 2, } ); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ 'abel' ], [ ], [ 'jerky' ], [ ], [ ], ); $unique_all_ref = get_unique_all( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], unsorted => 1, } ); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %pred = map {$_, 1} qw( abel icon jerky ); @unpred = qw| baker camera delta edward fargo golfer hilton |; @complement = get_complement( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], unsorted => 1, item => 1, } ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = get_complement_ref( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], unsorted => 1, item => 1, } ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( hilton icon jerky ); @unpred = qw| abel baker camera delta edward fargo golfer |; @complement = get_complement( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], unsorted => 1, } ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = get_complement_ref( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], unsorted => 1, } ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel jerky ); @unpred = qw| baker camera delta edward fargo golfer hilton icon |; @symmetric_difference = get_symmetric_difference( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], unsorted => 1, } ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = get_symmetric_difference_ref( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], unsorted => 1, } ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = get_symdiff( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], unsorted => 1, } ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = get_symdiff_ref( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], unsorted => 1, } ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ qw( hilton icon jerky ) ], [ qw( abel icon jerky ) ], [ qw( abel baker camera delta edward ) ], [ qw( abel baker camera delta edward jerky ) ], [ qw( abel baker camera delta edward jerky ) ], ); $complement_all_ref = get_complement_all( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], unsorted => 1, } ); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %seen = (); %pred = map {$_, 1} qw( abel baker camera delta edward hilton icon jerky ); @unpred = qw| fargo golfer |; @nonintersection = get_nonintersection( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], unsorted => 1, } ); $seen{$_}++ foreach (@nonintersection); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); $nonintersection_ref = get_nonintersection_ref( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], unsorted => 1, } ); $seen{$_}++ foreach (@{$nonintersection_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); %pred = ( abel => 2, baker => 2, camera => 2, delta => 3, edward => 2, fargo => 6, golfer => 5, hilton => 4, icon => 5, jerky => 1, ); @unpred = qw| kappa |; @bag = get_bag( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], unsorted => 1, } ); $seen{$_}++ foreach (@bag); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $bag_ref = get_bag_ref( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], unsorted => 1, } ); $seen{$_}++ foreach (@{$bag_ref}); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); List-Compare-0.53/t/20_oo_hashes_dual_acc_unsorted.t0000755000175000017500000003610412465263760022231 0ustar jkeenanjkeenan# perl #$Id$ # 20_oo_hashes_dual_acc_unsorted.t use strict; use Test::More tests => 109; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :hashes :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; ### new ### my $lcu = List::Compare->new('-u', '-a', \%h0, \%h1); ok($lcu, "constructor returned true value"); %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton ); @unpred = qw| icon jerky |; @union = $lcu->get_union; $seen{$_}++ foreach (@union); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); $union_ref = $lcu->get_union_ref; $seen{$_}++ foreach (@{$union_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton ); { my ($rv, $stdout, $stderr); capture( sub { @shared = $lcu->get_shared; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@shared); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); { my ($rv, $stdout, $stderr); capture( sub { $shared_ref = $lcu->get_shared_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$shared_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer ); @unpred = qw| abel hilton icon jerky |; @intersection = $lcu->get_intersection; $seen{$_}++ foreach (@intersection); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); $intersection_ref = $lcu->get_intersection_ref; $seen{$_}++ foreach (@{$intersection_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel ); @unpred = qw| baker camera delta edward fargo golfer hilton icon jerky |; @unique = $lcu->get_unique; $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcu->get_unique_ref; $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @unique = $lcu->get_Lonly; $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcu->get_Lonly_ref; $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @unique = $lcu->get_Aonly; $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcu->get_Aonly_ref; $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ 'abel' ], [ 'hilton' ], ); $unique_all_ref = $lcu->get_unique_all(); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_unique_all()"); %pred = map {$_, 1} qw( hilton ); @unpred = qw| abel baker camera delta edward fargo golfer icon jerky |; @complement = $lcu->get_complement; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcu->get_complement_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @complement = $lcu->get_Ronly; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcu->get_Ronly_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @complement = $lcu->get_Bonly; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcu->get_Bonly_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ qw( hilton ) ], [ qw( abel ) ], ); $complement_all_ref = $lcu->get_complement_all(); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %pred = map {$_, 1} qw( abel hilton ); @unpred = qw| baker camera delta edward fargo golfer icon jerky |; @symmetric_difference = $lcu->get_symmetric_difference; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_symmetric_difference_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcu->get_symdiff; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_symdiff_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcu->get_LorRonly; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_LorRonly_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcu->get_AorBonly; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_AorBonly_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel hilton ); @unpred = qw| baker camera delta edward fargo golfer icon jerky |; { my ($rv, $stdout, $stderr); capture( sub { @nonintersection = $lcu->get_nonintersection; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@nonintersection); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); { my ($rv, $stdout, $stderr); capture( sub { $nonintersection_ref = $lcu->get_nonintersection_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$nonintersection_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); %pred = ( abel => 2, baker => 2, camera => 2, delta => 3, edward => 2, fargo => 2, golfer => 2, hilton => 1, ); @unpred = qw| icon jerky |; @bag = $lcu->get_bag; $seen{$_}++ foreach (@bag); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $bag_ref = $lcu->get_bag_ref; $seen{$_}++ foreach (@{$bag_ref}); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $LR = $lcu->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); $LR = $lcu->is_AsubsetB; ok(! $LR, "Got expected subset relationship"); $RL = $lcu->is_RsubsetL; ok(! $RL, "Got expected subset relationship"); $RL = $lcu->is_BsubsetA; ok(! $RL, "Got expected subset relationship"); $eqv = $lcu->is_LequivalentR; ok(! $eqv, "Got expected equivalent relationship"); $eqv = $lcu->is_LeqvlntR; ok(! $eqv, "Got expected equivalent relationship"); $disj = $lcu->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcu->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcu->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } ok(wrap_is_member_which( $lcu, $test_members_which, ), "is_member_which() returned all expected values"); ok(wrap_is_member_which_ref( $lcu, $test_members_which, ), "is_member_which_ref() returned all expected values"); $memb_hash_ref = $lcu->are_members_which( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); ok(wrap_are_members_which( $memb_hash_ref, $test_members_which, ), "are_members_which() returned all expected value"); ok(wrap_is_member_any( $lcu, $test_members_any, ), "is_member_any() returned all expected values"); $memb_hash_ref = $lcu->are_members_any( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); ok(wrap_are_members_any( $memb_hash_ref, $test_members_any, ), "are_members_any() returned all expected values"); $vers = $lcu->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lcu_s = List::Compare->new('-u', '-a', \%h2, \%h3); ok($lcu_s, "constructor returned true value"); $LR = $lcu_s->is_LsubsetR; ok(! $LR, "non-subset correctly determined"); $LR = $lcu_s->is_AsubsetB; ok(! $LR, "non-subset correctly determined"); $RL = $lcu_s->is_RsubsetL; ok($RL, "subset correctly determined"); $RL = $lcu_s->is_BsubsetA; ok($RL, "subset correctly determined"); $eqv = $lcu_s->is_LequivalentR; ok(! $eqv, "non-equivalence correctly determined"); $eqv = $lcu_s->is_LeqvlntR; ok(! $eqv, "non-equivalence correctly determined"); $disj = $lcu_s->is_LdisjointR; ok(! $disj, "non-disjoint correctly determined"); ### new ### my $lcu_e = List::Compare->new('-u', '-a', \%h3, \%h4); ok($lcu_e, "constructor returned true value"); $eqv = $lcu_e->is_LequivalentR; ok($eqv, "Got expected equivalent relationship"); $eqv = $lcu_e->is_LeqvlntR; ok($eqv, "Got expected equivalent relationship"); $disj = $lcu_e->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); ### new ### my $lcu_dj = List::Compare->new('-u', \%h4, \%h8); ok($lcu_dj, "constructor returned true value"); ok(0 == $lcu_dj->get_intersection, "no intersection, as expected"); ok(0 == scalar(@{$lcu_dj->get_intersection_ref}), "no intersection, as expected"); $disj = $lcu_dj->is_LdisjointR; ok($disj, "disjoint correctly determined"); ########## BELOW: Tests for '--unsorted' and '--accelerated' options ########## my $lcaun = List::Compare->new('--unsorted', '-a', \%h0, \%h1); ok($lcaun, "Constructor worked with --unsorted and -a options"); my $lcaun_s = List::Compare->new('--unsorted', '-a', \%h2, \%h3); ok($lcaun_s, "Constructor worked with --unsorted and -a options"); my $lcaun_e = List::Compare->new('--unsorted', '-a', \%h3, \%h4); ok($lcaun_e, "Constructor worked with --unsorted and -a options"); my $lcaccun = List::Compare->new('--unsorted', '--accelerated', \%h0, \%h1); ok($lcaccun, "Constructor worked with --unsorted and --accelerated options"); my $lcaccun_s = List::Compare->new('--unsorted', '--accelerated', \%h2, \%h3); ok($lcaccun_s, "Constructor worked with --unsorted and --accelerated options"); my $lcaccun_e = List::Compare->new('--unsorted', '--accelerated', \%h3, \%h4); ok($lcaccun_e, "Constructor worked with --unsorted and --accelerated options"); my $lcaccu = List::Compare->new('-u', '--accelerated', \%h0, \%h1); ok($lcaccu, "Constructor worked with -u and --accelerated options"); my $lcaccu_s = List::Compare->new('-u', '--accelerated', \%h2, \%h3); ok($lcaccu_s, "Constructor worked with -u and --accelerated options"); my $lcaccu_e = List::Compare->new('-u', '--accelerated', \%h3, \%h4); ok($lcaccu_e, "Constructor worked with -u and --accelerated options"); List-Compare-0.53/t/42_func_hashes_dual_unsorted.t0000755000175000017500000001563712465263760021755 0ustar jkeenanjkeenan# perl #$Id$ # 42_func_hashes_dual_unsorted.t use strict; use Test::More tests => 38; use List::Compare::Functional qw(:originals :aliases); use lib ("./t"); use Test::ListCompareSpecial qw( :seen :func_wrap :hashes :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref); my @args; %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton ); @unpred = qw| icon jerky |; @union = get_union( '-u', [ \%h0, \%h1 ] ); $seen{$_}++ foreach (@union); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); $union_ref = get_union_ref( '-u', [ \%h0, \%h1 ] ); $seen{$_}++ foreach (@{$union_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer ); @unpred = qw| abel hilton icon jerky |; @shared = get_shared( '-u', [ \%h0, \%h1 ] ); $seen{$_}++ foreach (@shared); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); $shared_ref = get_shared_ref( '-u', [ \%h0, \%h1 ] ); $seen{$_}++ foreach (@{$shared_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer ); @unpred = qw| abel hilton icon jerky |; @intersection = get_intersection( '-u', [ \%h0, \%h1 ] ); $seen{$_}++ foreach (@intersection); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); $intersection_ref = get_intersection_ref( '-u', [ \%h0, \%h1 ] ); $seen{$_}++ foreach (@{$intersection_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel ); @unpred = qw| baker camera delta edward fargo golfer hilton icon jerky |; @unique = get_unique( '-u', [ \%h0, \%h1 ] ); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = get_unique_ref( '-u', [ \%h0, \%h1 ] ); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ 'abel' ], [ 'hilton' ], ); $unique_all_ref = get_unique_all( '-u', [ \%h0, \%h1 ] ); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_unique_all()"); %pred = map {$_, 1} qw( hilton ); @unpred = qw| abel baker camera delta edward fargo golfer icon jerky |; @complement = get_complement( '-u', [ \%h0, \%h1 ] ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = get_complement_ref( '-u', [ \%h0, \%h1 ] ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ qw( hilton ) ], [ qw( abel ) ], ); $complement_all_ref = get_complement_all( '-u', [ \%h0, \%h1 ] ); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %pred = map {$_, 1} qw( abel hilton ); @unpred = qw| baker camera delta edward fargo golfer icon jerky |; @symmetric_difference = get_symmetric_difference( '-u', [ \%h0, \%h1 ] ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = get_symmetric_difference_ref( '-u', [ \%h0, \%h1 ] ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = get_symdiff( '-u', [ \%h0, \%h1 ] ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = get_symdiff_ref( '-u', [ \%h0, \%h1 ] ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel hilton ); @unpred = qw| baker camera delta edward fargo golfer icon jerky |; @nonintersection = get_nonintersection( '-u', [ \%h0, \%h1 ] ); $seen{$_}++ foreach (@nonintersection); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); $nonintersection_ref = get_nonintersection_ref( '-u', [ \%h0, \%h1 ] ); $seen{$_}++ foreach (@{$nonintersection_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); %pred = ( abel => 2, baker => 2, camera => 2, delta => 3, edward => 2, fargo => 2, golfer => 2, hilton => 1, ); @unpred = qw| icon jerky |; @bag = get_bag( '-u', [ \%h0, \%h1 ] ); $seen{$_}++ foreach (@bag); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $bag_ref = get_bag_ref( '-u', [ \%h0, \%h1 ] ); $seen{$_}++ foreach (@{$bag_ref}); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); List-Compare-0.53/t/49_lc_subset.t0000755000175000017500000001237112535072055016512 0ustar jkeenanjkeenan# perl #$Id$ # 50_lcf_subset.t use strict; use Test::More tests => 52; use List::Compare; my @a0 = ( qw| alpha | ); my @a1 = ( qw| alpha beta | ); my @a2 = ( qw| alpha beta gamma | ); my @a3 = ( qw| gamma | ); my ($lc, $LR, $RL); $lc = List::Compare->new( [], [] ); $LR = $lc->is_LsubsetR(); ok($LR, "simple: empty array is subset of itself"); $lc = List::Compare->new( [], [] ); $RL = $lc->is_RsubsetL(); ok($RL, "simple: empty array is subset of itself"); $lc = List::Compare->new( \@a0, \@a0 ); $LR = $lc->is_LsubsetR(); ok($LR, "simple: array is subset of itself"); $lc = List::Compare->new( \@a0, \@a0 ); $RL = $lc->is_RsubsetL(); ok($RL, "simple: array is subset of itself"); $lc = List::Compare->new( \@a0, \@a3 ); $LR = $lc->is_LsubsetR(); ok(! $LR, "simple: disjoint are not subsets"); $lc = List::Compare->new( \@a0, \@a3 ); $RL = $lc->is_RsubsetL(); ok(! $RL, "simple: disjoint are not subsets"); $lc = List::Compare->new( \@a0, \@a1 ); $LR = $lc->is_LsubsetR(); ok($LR, "simple: left is subset of right"); $LR = $lc->is_AsubsetB(); ok($LR, "simple: left is subset of right"); $RL = $lc->is_RsubsetL(); ok(! $RL, "simple: right is not subset of left"); $RL = $lc->is_BsubsetA(); ok(! $RL, "simple: right is not subset of left"); $lc = List::Compare->new( '-u', \@a0, \@a1 ); $LR = $lc->is_LsubsetR(); ok($LR, "simple unsorted: left is subset of right"); $LR = $lc->is_AsubsetB(); ok($LR, "simple unsorted: left is subset of right"); $RL = $lc->is_RsubsetL(); ok(! $RL, "simple unsorted: right is not subset of left"); $RL = $lc->is_BsubsetA(); ok(! $RL, "simple unsorted: right is not subset of left"); $lc = List::Compare->new( '--unsorted', \@a0, \@a1 ); $LR = $lc->is_LsubsetR(); ok($LR, "simple unsorted long: left is subset of right"); $LR = $lc->is_AsubsetB(); ok($LR, "simple unsorted long: left is subset of right"); $RL = $lc->is_RsubsetL(); ok(! $RL, "simple unsorted long: right is not subset of left"); $RL = $lc->is_BsubsetA(); ok(! $RL, "simple unsorted long: right is not subset of left"); $lc = List::Compare->new( { lists => [ [], [] ] } ); $LR = $lc->is_LsubsetR(); ok($LR, "lists: empty array is subset of itself"); $lc = List::Compare->new( { lists => [ [], [] ] } ); $RL = $lc->is_RsubsetL(); ok($LR, "lists: empty array is subset of itself"); $lc = List::Compare->new( { lists => [ \@a0, \@a0 ] } ); $LR = $lc->is_LsubsetR(); ok($LR, "lists: array is subset of itself"); $lc = List::Compare->new( { lists => [ \@a0, \@a0 ] } ); $RL = $lc->is_RsubsetL(); ok($RL, "lists: array is subset of itself"); $lc = List::Compare->new( { lists => [ \@a0, \@a3 ] } ); $LR = $lc->is_LsubsetR(); ok(! $LR, "lists: disjoint are not subsets"); $lc = List::Compare->new( { lists => [ \@a0, \@a3 ] } ); $RL = $lc->is_RsubsetL(); ok(! $RL, "lists: disjoint are not subsets"); $lc = List::Compare->new( { lists => [ \@a0, \@a1 ] } ); $LR = $lc->is_LsubsetR(); ok($LR, "lists: left is subset of right"); $LR = $lc->is_AsubsetB(); ok($LR, "lists: left is subset of right"); $RL = $lc->is_RsubsetL(); ok(! $RL, "lists: right is not subset of left"); $RL = $lc->is_BsubsetA(); ok(! $RL, "lists: right is not subset of left"); $lc = List::Compare->new( { lists => [ \@a0, \@a1 ], unsorted => 1 } ); $LR = $lc->is_LsubsetR(); ok($LR, "lists: left is subset of right"); $LR = $lc->is_AsubsetB(); ok($LR, "lists: left is subset of right"); $RL = $lc->is_RsubsetL(); ok(! $RL, "lists: right is not subset of left"); $RL = $lc->is_BsubsetA(); ok(! $RL, "lists: right is not subset of left"); $lc = List::Compare->new( '-a', \@a0, \@a1 ); $LR = $lc->is_LsubsetR(); ok($LR, "simple accelerated: left is subset of right"); $LR = $lc->is_AsubsetB(); ok($LR, "simple accelerated: left is subset of right"); $RL = $lc->is_RsubsetL(); ok(! $RL, "simple accelerated: right is not subset of left"); $RL = $lc->is_BsubsetA(); ok(! $RL, "simple accelerated: right is not subset of left"); $lc = List::Compare->new( '--accelerated', \@a0, \@a1 ); $LR = $lc->is_LsubsetR(); ok($LR, "simple accelerated long: left is subset of right"); $LR = $lc->is_AsubsetB(); ok($LR, "simple accelerated long: left is subset of right"); $RL = $lc->is_RsubsetL(); ok(! $RL, "simple accelerated long: right is not subset of left"); $RL = $lc->is_BsubsetA(); ok(! $RL, "simple accelerated long: right is not subset of left"); $lc = List::Compare->new( { lists => [ \@a0, \@a1 ], accelerated => 1 } ); $LR = $lc->is_LsubsetR(); ok($LR, "lists: left is subset of right"); $LR = $lc->is_AsubsetB(); ok($LR, "lists: left is subset of right"); $RL = $lc->is_RsubsetL(); ok(! $RL, "lists: right is not subset of left"); $RL = $lc->is_BsubsetA(); ok(! $RL, "lists: right is not subset of left"); $lc = List::Compare->new( \@a0, \@a1, \@a2 ); $LR = $lc->is_LsubsetR(); ok($LR, "multiple: left is subset of right"); $LR = $lc->is_LsubsetR(0,1); ok($LR, "multiple: left is subset of right"); $LR = $lc->is_LsubsetR(1,2); ok($LR, "multiple: left is subset of right"); $LR = $lc->is_LsubsetR(0,2); ok($LR, "multiple: left is subset of right"); $LR = $lc->is_AsubsetB(); ok($LR, "multiple: left is subset of right"); $LR = $lc->is_AsubsetB(0,1); ok($LR, "multiple: left is subset of right"); $LR = $lc->is_AsubsetB(1,2); ok($LR, "multiple: left is subset of right"); $LR = $lc->is_AsubsetB(0,2); ok($LR, "multiple: left is subset of right"); List-Compare-0.53/t/05_oo_lists_mult_reg_sorted.t0000755000175000017500000004550312465263760021642 0ustar jkeenanjkeenan# perl #$Id$ # 05_oo_lists_mult_reg_sorted.t use strict; use Test::More tests => 115; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :arrays :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; ### new ### my $lcm = List::Compare->new(\@a0, \@a1, \@a2, \@a3, \@a4); ok($lcm, "List::Compare constructor returned true value"); @pred = qw(abel baker camera delta edward fargo golfer hilton icon jerky); @union = $lcm->get_union; is_deeply( \@union, \@pred, "Got expected union"); $union_ref = $lcm->get_union_ref; is_deeply( $union_ref, \@pred, "Got expected union"); @pred = qw(baker camera delta edward fargo golfer hilton icon); @shared = $lcm->get_shared; is_deeply( \@shared, \@pred, "Got expected shared"); $shared_ref = $lcm->get_shared_ref; is_deeply( $shared_ref, \@pred, "Got expected shared"); @pred = qw(fargo golfer); @intersection = $lcm->get_intersection; is_deeply(\@intersection, \@pred, "Got expected intersection"); $intersection_ref = $lcm->get_intersection_ref; is_deeply($intersection_ref, \@pred, "Got expected intersection"); @pred = qw( jerky ); @unique = $lcm->get_unique(2); is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lcm->get_unique_ref(2); is_deeply($unique_ref, \@pred, "Got expected unique"); eval { $unique_ref = $lcm->get_unique_ref('jerky') }; like($@, qr/Argument to method List::Compare::Multiple::get_unique_ref must be the array index/, "Got expected error message" ); eval { $unique_ref = $lcm->get_unique_ref(999) }; like($@, qr/Argument to method List::Compare::Multiple::get_unique_ref must be the array index/, "Got expected error message" ); { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Lonly(2); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Lonly_ref(2); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Aonly(2); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Aonly_ref(2); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } @pred = qw( abel ); @unique = $lcm->get_unique; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lcm->get_unique_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Lonly(); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Lonly_ref(); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Aonly(); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Aonly_ref(); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } @pred = ( [ 'abel' ], [ ], [ 'jerky' ], [ ], [ ], ); $unique_all_ref = $lcm->get_unique_all(); is_deeply($unique_all_ref, [ @pred ], "Got expected values for get_unique_all()"); @pred = qw( abel icon jerky ); @complement = $lcm->get_complement(1); is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lcm->get_complement_ref(1); is_deeply($complement_ref, \@pred, "Got expected complement"); eval { $complement_ref = $lcm->get_complement_ref('jerky') }; like($@, qr/Argument to method List::Compare::Multiple::get_complement_ref must be the array index/, "Got expected error message" ); eval { $complement_ref = $lcm->get_complement_ref(999) }; like($@, qr/Argument to method List::Compare::Multiple::get_complement_ref must be the array index/, "Got expected error message" ); { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Ronly(1); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Ronly_ref(1); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Bonly(1); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Bonly_ref(1); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } @pred = qw ( hilton icon jerky ); @complement = $lcm->get_complement; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lcm->get_complement_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Ronly(); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Ronly_ref(); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Bonly(); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Bonly_ref(); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } @pred = ( [ qw( hilton icon jerky ) ], [ qw( abel icon jerky ) ], [ qw( abel baker camera delta edward ) ], [ qw( abel baker camera delta edward jerky ) ], [ qw( abel baker camera delta edward jerky ) ], ); $complement_all_ref = $lcm->get_complement_all(); is_deeply($complement_all_ref, [ @pred ], "Got expected values for get_complement_all()"); @pred = qw( abel jerky ); @symmetric_difference = $lcm->get_symmetric_difference; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lcm->get_symmetric_difference_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lcm->get_symdiff; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lcm->get_symdiff_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); { my ($rv, $stdout, $stderr); capture( sub { @symmetric_difference = $lcm->get_LorRonly; }, \$stdout, \$stderr, ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcm->get_LorRonly_ref; }, \$stdout, \$stderr, ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @symmetric_difference = $lcm->get_AorBonly; }, \$stdout, \$stderr, ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcm->get_AorBonly_ref; }, \$stdout, \$stderr, ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly_ref or its alias defaults/, "Got expected warning", ); } @pred = qw( abel baker camera delta edward hilton icon jerky ); @nonintersection = $lcm->get_nonintersection; is_deeply( \@nonintersection, \@pred, "Got expected nonintersection"); $nonintersection_ref = $lcm->get_nonintersection_ref; is_deeply($nonintersection_ref, \@pred, "Got expected nonintersection"); @pred = qw( abel abel baker baker camera camera delta delta delta edward edward fargo fargo fargo fargo fargo fargo golfer golfer golfer golfer golfer hilton hilton hilton hilton icon icon icon icon icon jerky ); @bag = $lcm->get_bag; is_deeply(\@bag, \@pred, "Got expected bag"); $bag_ref = $lcm->get_bag_ref; is_deeply($bag_ref, \@pred, "Got expected bag"); $LR = $lcm->is_LsubsetR(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcm->is_AsubsetB(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcm->is_LsubsetR(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcm->is_AsubsetB(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcm->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); eval { $LR = $lcm->is_LsubsetR(2) }; like($@, qr/Method List::Compare::Multiple::is_LsubsetR requires 2 arguments/, "Got expected error message" ); eval { $LR = $lcm->is_LsubsetR(8,9) }; like($@, qr/Each argument to method List::Compare::Multiple::is_LsubsetR must be a valid array index /, "Got expected error message" ); eval { $LR = $lcm->is_LsubsetR('jerky', 3) }; like($@, qr/Each argument to method List::Compare::Multiple::is_LsubsetR must be a valid array index /, "Got expected error message" ); { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcm->is_RsubsetL; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcm->is_BsubsetA; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } $eqv = $lcm->is_LequivalentR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcm->is_LeqvlntR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcm->is_LequivalentR(2,4); ok(! $eqv, "Got expected equivalence relationship"); eval { $eqv = $lcm->is_LequivalentR(2) }; like($@, qr/Method List::Compare::Multiple::is_LequivalentR requires 2 arguments/, "Got expected error message", ); eval { $eqv = $lcm->is_LequivalentR(8,9) }; like($@, qr/Each argument to method List::Compare::Multiple::is_LequivalentR must be a valid array index/, "Got expected error message", ); eval { $LR = $lcm->is_LequivalentR('jerky', 3) }; like($@, qr/Each argument to method List::Compare::Multiple::is_LequivalentR must be a valid array index /, "Got expected error message" ); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcm->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcm->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); is_deeply( all_is_member_which( $lcm, \@args), $test_member_which_mult, "is_member_which() returned all expected values"); eval { $memb_arr_ref = $lcm->is_member_which('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which() correctly generated error message"); is_deeply( all_is_member_which_ref( $lcm, \@args), $test_member_which_mult, "is_member_which_ref() returned all expected values"); eval { $memb_arr_ref = $lcm->is_member_which_ref('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which_ref() correctly generated error message"); eval { $memb_arr_ref = $lcm->is_member_which_ref( [ 'jerky' ] ) }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which_ref() correctly generated error message"); $memb_hash_ref = $lcm->are_members_which( \@args ); is_deeply($memb_hash_ref, $test_members_which_mult, "are_members_which() returned all expected values"); eval { $memb_hash_ref = $lcm->are_members_which( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_which() correctly generated error message"); eval { $memb_hash_ref = $lcm->are_members_which( \@args, [ 1 .. 3 ] ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_which() correctly generated error message"); is_deeply( all_is_member_any( $lcm, \@args), $test_member_any_mult, "is_member_which() returned all expected values"); eval { $lcm->is_member_any('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_any() correctly generated error message"); eval { $lcm->is_member_any( [ 'jerky' ] ) }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_any() correctly generated error message"); $memb_hash_ref = $lcm->are_members_any( \@args ); ok(wrap_are_members_any( $memb_hash_ref, $test_members_any_mult, ), "are_members_any() returned all expected values"); eval { $memb_hash_ref = $lcm->are_members_any( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_any() correctly generated error message"); eval { $memb_hash_ref = $lcm->are_members_any( \@args, [ 1..3 ] ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_any() correctly generated error message"); $vers = $lcm->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lcm_dj = List::Compare->new(\@a0, \@a1, \@a2, \@a3, \@a4, \@a8); ok($lcm_dj, "Constructor returned true value"); $disj = $lcm_dj->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); $disj = $lcm_dj->is_LdisjointR(2,3); ok(! $disj, "Got expected disjoint relationship"); $disj = $lcm_dj->is_LdisjointR(4,5); ok($disj, "Got expected disjoint relationship"); eval { $disj = $lcm_dj->is_LdisjointR(2) }; like($@, qr/Method List::Compare::Multiple::is_LdisjointR requires 2 arguments/, "Got expected error message"); eval { $LR = $lcm->is_LdisjointR('jerky', 3) }; like($@, qr/Each argument to method List::Compare::Multiple::is_LdisjointR must be a valid array index /, "Got expected error message" ); ########## BELOW: Testfor bad arguments to constructor ########## my ($lcm_bad); my %h5 = ( golfer => 1, lambda => 0, ); eval { $lcm_bad = List::Compare->new('-u', \@a0, \@a1, \@a2, \@a3, \%h5) }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); eval { $lcm_bad = List::Compare->new('-u', \%h5, \@a0, \@a1, \@a2, \@a3) }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); my $scalar = 'test'; eval { $lcm_bad = List::Compare->new(\$scalar, \@a0, \@a1) }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); List-Compare-0.53/t/10_oo_lists_alt_dual_reg_unsorted.t0000755000175000017500000003441312465263760023003 0ustar jkeenanjkeenan# perl #$Id$ # 10_oo_lists_alt_dual_reg_unsorted.t use strict; use Test::More tests => 103; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :arrays :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); ### new ### my $lcu = List::Compare->new( { unsorted => 1, lists => [ \@a0, \@a1 ], } ); ok($lcu, "constructor returned true value"); %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton ); @unpred = qw| icon jerky |; @union = $lcu->get_union; $seen{$_}++ foreach (@union); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); $union_ref = $lcu->get_union_ref; $seen{$_}++ foreach (@{$union_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer ); @unpred = qw| abel hilton icon jerky |; @intersection = $lcu->get_intersection; $seen{$_}++ foreach (@intersection); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); $intersection_ref = $lcu->get_intersection_ref; $seen{$_}++ foreach (@{$intersection_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); { my ($rv, $stdout, $stderr); capture( sub { @shared = $lcu->get_shared; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@shared); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); { my ($rv, $stdout, $stderr); capture( sub { $shared_ref = $lcu->get_shared_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$shared_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); %pred = map {$_, 1} qw( abel ); @unpred = qw| baker camera delta edward fargo golfer hilton icon jerky |; @unique = $lcu->get_unique; $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcu->get_unique_ref; $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @unique = $lcu->get_Lonly; $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcu->get_Lonly_ref; $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @unique = $lcu->get_Aonly; $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcu->get_Aonly_ref; $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ 'abel' ], [ 'hilton' ], ); $unique_all_ref = $lcu->get_unique_all(); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %pred = map {$_, 1} qw( hilton ); @unpred = qw| abel baker camera delta edward fargo golfer icon jerky |; @complement = $lcu->get_complement; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcu->get_complement_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @complement = $lcu->get_Ronly; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcu->get_Ronly_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @complement = $lcu->get_Bonly; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcu->get_Bonly_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ qw( hilton ) ], [ qw( abel ) ], ); $complement_all_ref = $lcu->get_complement_all(); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %pred = map {$_, 1} qw( abel hilton ); @unpred = qw| baker camera delta edward fargo golfer icon jerky |; @symmetric_difference = $lcu->get_symmetric_difference; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_symmetric_difference_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcu->get_symdiff; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_symdiff_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcu->get_LorRonly; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_LorRonly_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcu->get_AorBonly; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_AorBonly_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel hilton ); @unpred = qw| baker camera delta edward fargo golfer icon jerky |; { my ($rv, $stdout, $stderr); capture( sub { @nonintersection = $lcu->get_nonintersection; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@nonintersection); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); { my ($rv, $stdout, $stderr); capture( sub { $nonintersection_ref = $lcu->get_nonintersection_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$nonintersection_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); %pred = ( abel => 2, baker => 2, camera => 2, delta => 3, edward => 2, fargo => 2, golfer => 2, hilton => 1, ); @unpred = qw| icon jerky |; @bag = $lcu->get_bag; $seen{$_}++ foreach (@bag); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $bag_ref = $lcu->get_bag_ref; $seen{$_}++ foreach (@{$bag_ref}); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $LR = $lcu->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); $LR = $lcu->is_AsubsetB; ok(! $LR, "Got expected subset relationship"); $RL = $lcu->is_RsubsetL; ok(! $RL, "Got expected subset relationship"); $RL = $lcu->is_BsubsetA; ok(! $RL, "Got expected subset relationship"); $eqv = $lcu->is_LequivalentR; ok(! $eqv, "Got expected equivalent relationship"); $eqv = $lcu->is_LeqvlntR; ok(! $eqv, "Got expected equivalent relationship"); $disj = $lcu->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcu->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcu->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } ok(wrap_is_member_which( $lcu, $test_members_which, ), "is_member_which() returned all expected values"); ok(wrap_is_member_which_ref( $lcu, $test_members_which, ), "is_member_which_ref() returned all expected values"); $memb_hash_ref = $lcu->are_members_which( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); ok(wrap_are_members_which( $memb_hash_ref, $test_members_which, ), "are_members_which() returned all expected value"); ok(wrap_is_member_any( $lcu, $test_members_any, ), "is_member_any() returned all expected values"); $memb_hash_ref = $lcu->are_members_any( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); ok(wrap_are_members_any( $memb_hash_ref, $test_members_any, ), "are_members_any() returned all expected values"); $vers = $lcu->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lcu_s = List::Compare->new( { unsorted => 1, lists => [ \@a2, \@a3 ], } ); ok($lcu_s, "constructor returned true value"); $LR = $lcu_s->is_LsubsetR; ok(! $LR, "non-subset correctly determined"); $LR = $lcu_s->is_AsubsetB; ok(! $LR, "non-subset correctly determined"); $RL = $lcu_s->is_RsubsetL; ok($RL, "subset correctly determined"); $RL = $lcu_s->is_BsubsetA; ok($RL, "subset correctly determined"); $eqv = $lcu_s->is_LequivalentR; ok(! $eqv, "non-equivalence correctly determined"); $eqv = $lcu_s->is_LeqvlntR; ok(! $eqv, "non-equivalence correctly determined"); $disj = $lcu_s->is_LdisjointR; ok(! $disj, "non-disjoint correctly determined"); ### new ### my $lcu_e = List::Compare->new( { unsorted => 1, lists => [ \@a3, \@a4 ], } ); ok($lcu_e, "constructor returned true value"); $eqv = $lcu_e->is_LequivalentR; ok($eqv, "Got expected equivalent relationship"); $eqv = $lcu_e->is_LeqvlntR; ok($eqv, "Got expected equivalent relationship"); $disj = $lcu_e->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); ### new ### my $lcu_dj = List::Compare->new( { unsorted => 1, lists => [ \@a4, \@a8 ], } ); ok($lcu_dj, "constructor returned true value"); ok(0 == $lcu_dj->get_intersection, "no intersection, as expected"); ok(0 == scalar(@{$lcu_dj->get_intersection_ref}), "no intersection, as expected"); $disj = $lcu_dj->is_LdisjointR; ok($disj, "disjoint correctly determined"); ########## BELOW: Tests for '--unsorted' option ########## my $lcun = List::Compare->new( { unsorted => 1, lists => [ \@a0, \@a1 ], } ); ok($lcun, "constructor returned true value"); my $lcun_s = List::Compare->new( { unsorted => 1, lists => [ \@a2, \@a3 ], } ); ok($lcun_s, "constructor returned true value"); my $lcun_e = List::Compare->new( { unsorted => 1, lists => [ \@a3, \@a4 ], } ); ok($lcun_e, "constructor returned true value"); List-Compare-0.53/t/45_func_hashes_alt_dual_sorted.t0000755000175000017500000001573612465263760022255 0ustar jkeenanjkeenan# perl #$Id$ # 45_func_hashes_alt_dual_sorted.t use strict; use Test::More tests => 46; use List::Compare::Functional qw(:originals :aliases); use lib ("./t"); use Test::ListCompareSpecial qw( :seen :func_wrap :hashes :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref); my @args; @pred = qw(abel baker camera delta edward fargo golfer hilton); @union = get_union( { lists => [ \%h0, \%h1 ] } ); is_deeply( \@union, \@pred, "Got expected union"); $union_ref = get_union_ref( { lists => [ \%h0, \%h1 ] } ); is_deeply( $union_ref, \@pred, "Got expected union"); @pred = qw( baker camera delta edward fargo golfer ); @shared = get_shared( { lists => [ \%h0, \%h1 ] } ); is_deeply( \@shared, \@pred, "Got expected shared"); $shared_ref = get_shared_ref( { lists => [ \%h0, \%h1 ] } ); is_deeply( $shared_ref, \@pred, "Got expected shared"); @pred = qw( baker camera delta edward fargo golfer ); @intersection = get_intersection( { lists => [ \%h0, \%h1 ] } ); is_deeply(\@intersection, \@pred, "Got expected intersection"); $intersection_ref = get_intersection_ref( { lists => [ \%h0, \%h1 ] } ); is_deeply($intersection_ref, \@pred, "Got expected intersection"); @pred = qw( abel ); @unique = get_unique( { lists => [ \%h0, \%h1 ] } ); is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = get_unique_ref( { lists => [ \%h0, \%h1 ] } ); is_deeply($unique_ref, \@pred, "Got expected unique"); @pred = ( [ 'abel' ], [ 'hilton' ], ); $unique_all_ref = get_unique_all( { lists => [ \%h0, \%h1 ] } ); is_deeply($unique_all_ref, [ @pred ], "Got expected values for get_unique_all()"); @pred = qw ( hilton ); @complement = get_complement( { lists => [ \%h0, \%h1 ] } ); is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = get_complement_ref( { lists => [ \%h0, \%h1 ] } ); is_deeply($complement_ref, \@pred, "Got expected complement"); @pred = ( [ qw( hilton ) ], [ qw( abel ) ], ); $complement_all_ref = get_complement_all( { lists => [ \%h0, \%h1 ] } ); is_deeply($complement_all_ref, [ @pred ], "Got expected values for get_complement_all()"); @pred = qw( abel hilton ); @symmetric_difference = get_symmetric_difference( { lists => [ \%h0, \%h1 ] } ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = get_symmetric_difference_ref( { lists => [ \%h0, \%h1 ] } ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = get_symdiff( { lists => [ \%h0, \%h1 ] } ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = get_symdiff_ref( { lists => [ \%h0, \%h1 ] } ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @pred = qw( abel hilton ); @nonintersection = get_nonintersection( { lists => [ \%h0, \%h1 ] } ); is_deeply(\@nonintersection, \@pred, "Got expected nonintersection"); $nonintersection_ref = get_nonintersection_ref( { lists => [ \%h0, \%h1 ] } ); is_deeply($nonintersection_ref, \@pred, "Got expected nonintersection"); @pred = qw( abel abel baker baker camera camera delta delta delta edward edward fargo fargo golfer golfer hilton ); @bag = get_bag( { lists => [ \%h0, \%h1 ] } ); is_deeply(\@bag, \@pred, "Got expected bag"); $bag_ref = get_bag_ref( { lists => [ \%h0, \%h1 ] } ); is_deeply($bag_ref, \@pred, "Got expected bag"); $LR = is_LsubsetR( { lists => [ \%h0, \%h1 ] } ); ok(! $LR, "Got expected subset relationship"); $RL = is_RsubsetL( { lists => [ \%h0, \%h1 ] } ); ok(! $RL, "Got expected subset relationship"); $eqv = is_LequivalentR( { lists => [ \%h0, \%h1 ] } ); ok(! $eqv, "Got expected equivalent relationship"); $eqv = is_LeqvlntR( { lists => [ \%h0, \%h1 ] } ); ok(! $eqv, "Got expected equivalent relationship"); $disj = is_LdisjointR( { lists => [ \%h0, \%h1 ] } ); ok(! $disj, "Got expected disjoint relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = print_subset_chart( { lists => [ \%h0, \%h1 ] } ); }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = print_equivalence_chart( { lists => [ \%h0, \%h1 ] } ); }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); is_deeply(func_all_is_member_which_alt( [ \%h0, \%h1 ], \@args ), $test_member_which_dual, "is_member_which() returned all expected values"); is_deeply(func_all_is_member_which_ref_alt( [ \%h0, \%h1 ], \@args ), $test_member_which_dual, "is_member_which() returned all expected values"); $memb_hash_ref = are_members_which( { lists => [ \%h0, \%h1 ], items => \@args, } ); ok(func_wrap_are_members_which( $memb_hash_ref, $test_members_which, ), "are_members_which() returned all expected values"); is_deeply(func_all_is_member_any( [ \%h0, \%h1 ], \@args ), $test_member_any_dual, "is_member_any() returned all expected values"); $memb_hash_ref = are_members_any( { lists => [ \%h0, \%h1 ], items => \@args, } ); ok(func_wrap_are_members_any( $memb_hash_ref, $test_members_any, ), "are_members_any() returned all expected values"); $vers = get_version; ok($vers, "get_version() returned true value"); $LR = is_LsubsetR( { lists => [ \%h2, \%h3 ] } ); ok(! $LR, "non-subset correctly determined"); $RL = is_RsubsetL( { lists => [ \%h2, \%h3 ] } ); ok($RL, "subset correctly determined"); $eqv = is_LequivalentR( { lists => [ \%h2, \%h3 ] } ); ok(! $eqv, "non-equivalence correctly determined"); $eqv = is_LeqvlntR( { lists => [ \%h2, \%h3 ] } ); ok(! $eqv, "non-equivalence correctly determined"); $disj = is_LdisjointR( { lists => [ \%h2, \%h3 ] } ); ok(! $disj, "non-disjoint correctly determined"); $eqv = is_LequivalentR( { lists => [ \%h3, \%h4 ] } ); ok($eqv, "equivalence correctly determined"); $eqv = is_LeqvlntR( { lists => [ \%h3, \%h4 ] } ); ok($eqv, "equivalence correctly determined"); $disj = is_LdisjointR( { lists => [ \%h3, \%h4 ] } ); ok(! $disj, "non-disjoint correctly determined"); ok(0 == get_intersection( { lists => [ \%h4, \%h8 ] } ), "no intersection, as expected"); ok(0 == scalar(@{get_intersection_ref( { lists => [ \%h4, \%h8 ] } )}), "no intersection, as expected"); $disj = is_LdisjointR( { lists => [ \%h4, \%h8 ] } ); ok($disj, "disjoint correctly determined"); List-Compare-0.53/t/12_oo_lists_alt_dual_acc_unsorted.t0000755000175000017500000003364712465263760022766 0ustar jkeenanjkeenan# perl #$Id$ # 12_oo_lists_alt_dual_acc_unsorted.t use strict; use Test::More tests => 100; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :arrays :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); ### new ### my $lcu = List::Compare->new( { unsorted => 1, accelerated => 1, lists => [ \@a0, \@a1 ], } ); ok($lcu, "constructor returned true value"); %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton ); @unpred = qw| icon jerky |; @union = $lcu->get_union; $seen{$_}++ foreach (@union); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); $union_ref = $lcu->get_union_ref; $seen{$_}++ foreach (@{$union_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton ); { my ($rv, $stdout, $stderr); capture( sub { @shared = $lcu->get_shared; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@shared); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); { my ($rv, $stdout, $stderr); capture( sub { $shared_ref = $lcu->get_shared_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$shared_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer ); @unpred = qw| abel hilton icon jerky |; @intersection = $lcu->get_intersection; $seen{$_}++ foreach (@intersection); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); $intersection_ref = $lcu->get_intersection_ref; $seen{$_}++ foreach (@{$intersection_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel ); @unpred = qw| baker camera delta edward fargo golfer hilton icon jerky |; @unique = $lcu->get_unique; $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcu->get_unique_ref; $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @unique = $lcu->get_Lonly; $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcu->get_Lonly_ref; $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @unique = $lcu->get_Aonly; $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcu->get_Aonly_ref; $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ 'abel' ], [ 'hilton' ], ); $unique_all_ref = $lcu->get_unique_all(); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_unique_all()"); %pred = map {$_, 1} qw( hilton ); @unpred = qw| abel baker camera delta edward fargo golfer icon jerky |; @complement = $lcu->get_complement; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcu->get_complement_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @complement = $lcu->get_Ronly; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcu->get_Ronly_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @complement = $lcu->get_Bonly; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcu->get_Bonly_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ qw( hilton ) ], [ qw( abel ) ], ); $complement_all_ref = $lcu->get_complement_all(); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %pred = map {$_, 1} qw( abel hilton ); @unpred = qw| baker camera delta edward fargo golfer icon jerky |; @symmetric_difference = $lcu->get_symmetric_difference; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_symmetric_difference_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcu->get_symdiff; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_symdiff_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcu->get_LorRonly; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_LorRonly_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcu->get_AorBonly; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_AorBonly_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel hilton ); @unpred = qw| baker camera delta edward fargo golfer icon jerky |; { my ($rv, $stdout, $stderr); capture( sub { @nonintersection = $lcu->get_nonintersection; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@nonintersection); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); { my ($rv, $stdout, $stderr); capture( sub { $nonintersection_ref = $lcu->get_nonintersection_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$nonintersection_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); %pred = ( abel => 2, baker => 2, camera => 2, delta => 3, edward => 2, fargo => 2, golfer => 2, hilton => 1, ); @unpred = qw| icon jerky |; @bag = $lcu->get_bag; $seen{$_}++ foreach (@bag); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $bag_ref = $lcu->get_bag_ref; $seen{$_}++ foreach (@{$bag_ref}); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $LR = $lcu->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); $LR = $lcu->is_AsubsetB; ok(! $LR, "Got expected subset relationship"); $RL = $lcu->is_RsubsetL; ok(! $RL, "Got expected subset relationship"); $RL = $lcu->is_BsubsetA; ok(! $RL, "Got expected subset relationship"); $eqv = $lcu->is_LequivalentR; ok(! $eqv, "Got expected equivalent relationship"); $eqv = $lcu->is_LeqvlntR; ok(! $eqv, "Got expected equivalent relationship"); $disj = $lcu->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcu->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcu->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } ok(wrap_is_member_which( $lcu, $test_members_which, ), "is_member_which() returned all expected values"); ok(wrap_is_member_which_ref( $lcu, $test_members_which, ), "is_member_which_ref() returned all expected values"); $memb_hash_ref = $lcu->are_members_which( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); ok(wrap_are_members_which( $memb_hash_ref, $test_members_which, ), "are_members_which() returned all expected value"); ok(wrap_is_member_any( $lcu, $test_members_any, ), "is_member_any() returned all expected values"); $memb_hash_ref = $lcu->are_members_any( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); ok(wrap_are_members_any( $memb_hash_ref, $test_members_any, ), "are_members_any() returned all expected values"); $vers = $lcu->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lcu_s = List::Compare->new( { unsorted => 1, accelerated => 1, lists => [ \@a2, \@a3 ], } ); ok($lcu_s, "constructor returned true value"); $LR = $lcu_s->is_LsubsetR; ok(! $LR, "non-subset correctly determined"); $LR = $lcu_s->is_AsubsetB; ok(! $LR, "non-subset correctly determined"); $RL = $lcu_s->is_RsubsetL; ok($RL, "subset correctly determined"); $RL = $lcu_s->is_BsubsetA; ok($RL, "subset correctly determined"); $eqv = $lcu_s->is_LequivalentR; ok(! $eqv, "non-equivalence correctly determined"); $eqv = $lcu_s->is_LeqvlntR; ok(! $eqv, "non-equivalence correctly determined"); $disj = $lcu_s->is_LdisjointR; ok(! $disj, "non-disjoint correctly determined"); ### new ### my $lcu_e = List::Compare->new( { unsorted => 1, accelerated => 1, lists => [ \@a3, \@a4 ], } ); ok($lcu_e, "constructor returned true value"); $eqv = $lcu_e->is_LequivalentR; ok($eqv, "Got expected equivalent relationship"); $eqv = $lcu_e->is_LeqvlntR; ok($eqv, "Got expected equivalent relationship"); $disj = $lcu_e->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); ### new ### my $lcu_dj = List::Compare->new( { unsorted => 1, accelerated => 1, lists => [ \@a4, \@a8 ], } ); ok($lcu_dj, "constructor returned true value"); ok(0 == $lcu_dj->get_intersection, "no intersection, as expected"); ok(0 == scalar(@{$lcu_dj->get_intersection_ref}), "no intersection, as expected"); $disj = $lcu_dj->is_LdisjointR; ok($disj, "disjoint correctly determined"); List-Compare-0.53/t/90_oo_errors.t0000755000175000017500000001403012367450671016535 0ustar jkeenanjkeenan# perl #$Id$ # 01_oo_lists_dual_reg_sorted.t use strict; use Test::More tests => 30; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :arrays :hashes :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref); my @args; my ($lc, $lca); my %h10 = ( abel => 2, baker => 1, camera => 1, delta => 1, edward => 1, fargo => 1, golfer => q{one}, ); my %h11 = ( baker => 1, camera => 1, delta => 2, edward => 1, fargo => 1, golfer => 1, hilton => 1, ); my %h12 = ( fargo => 1, golfer => 1, hilton => 1, icon => 2, jerky => 1, ); eval { $lc = List::Compare->new(\%h10, \%h11); }; like($@, qr/Values in a 'seen-hash' may only be positive integers/s, "Got expected error message for left-hand hash which was not a seen-hash" ); like($@, qr/First hash in arguments/s, "Got expected error message for left-hand hash which was not a seen-hash" ); like($@, qr/Key:\s+golfer\s+Value:\s+one/s, "Got expected error message for left-hand hash which was not a seen-hash" ); eval { $lc = List::Compare->new('-a', \%h10, \%h11); }; like($@, qr/Values in a 'seen-hash' must be numeric/s, "Got expected error message for left-hand hash which was not a seen-hash" ); like($@, qr/First hash in arguments/s, "Got expected error message for left-hand hash which was not a seen-hash" ); like($@, qr/Key:\s+golfer\s+Value:\s+one/s, "Got expected error message for left-hand hash which was not a seen-hash" ); eval { $lc = List::Compare->new(\%h10, \%h11, \%h12); }; like($@, qr/Values in a 'seen-hash' must be positive integers/s, "Got expected error message for hash which was not a seen-hash" ); like($@, qr/Hash\s+0/s, "Got expected error message for hash which was not a seen-hash" ); like($@, qr/Bad key-value pair:\s+golfer\s+one/s, "Got expected error message for hash which was not a seen-hash" ); my %h20 = ( abel => 2, baker => 1, camera => 1, delta => 1, edward => 1, fargo => 1, golfer => 1, ); my %h21 = ( baker => 1, camera => 1, delta => 2, edward => 1, fargo => 1, golfer => 1, hilton => q{one}, ); eval { $lc = List::Compare->new(\%h20, \%h21); }; like($@, qr/Values in a 'seen-hash' may only be positive integers/s, "Got expected error message for right-hand hash which was not a seen-hash" ); like($@, qr/Second hash in arguments/s, "Got expected error message for right-hand hash which was not a seen-hash" ); like($@, qr/Key:\s+hilton\s+Value:\s+one/s, "Got expected error message for right-hand hash which was not a seen-hash" ); eval { $lc = List::Compare->new('-a', \%h20, \%h21); }; like($@, qr/Values in a 'seen-hash' must be numeric/s, "Got expected error message for right-hand hash which was not a seen-hash" ); like($@, qr/Second hash in arguments/s, "Got expected error message for right-hand hash which was not a seen-hash" ); like($@, qr/Key:\s+hilton\s+Value:\s+one/s, "Got expected error message for right-hand hash which was not a seen-hash" ); my %h30 = ( abel => 2, baker => 1, camera => 1, delta => 1, edward => 1, fargo => 1, golfer => 0, ); my %h31 = ( baker => 1, camera => 1, delta => 2, edward => 1, fargo => 1, golfer => 1, hilton => 1, ); eval { $lc = List::Compare->new(\%h30, \%h31); }; like($@, qr/Values in a 'seen-hash' may only be positive integers/s, "Got expected error message for left-hand hash which was not a seen-hash" ); like($@, qr/First hash in arguments/s, "Got expected error message for left-hand hash which was not a seen-hash" ); like($@, qr/Key:\s+golfer\s+Value:\s+0/s, "Got expected error message for left-hand hash which was not a seen-hash" ); eval { $lc = List::Compare->new('-a', \%h30, \%h31); }; like($@, qr/Values in a 'seen-hash' must be numeric/s, "Got expected error message for left-hand hash which was not a seen-hash" ); like($@, qr/First hash in arguments/s, "Got expected error message for left-hand hash which was not a seen-hash" ); like($@, qr/Key:\s+golfer\s+Value:\s+0/s, "Got expected error message for left-hand hash which was not a seen-hash" ); eval { $lc = List::Compare->new(\%h30, \%h31, \%h12); }; like($@, qr/Values in a 'seen-hash' must be positive integers/s, "Got expected error message for hash which was not a seen-hash" ); like($@, qr/Hash\s+0/s, "Got expected error message for hash which was not a seen-hash" ); like($@, qr/Bad key-value pair:\s+golfer\s+0/s, "Got expected error message for hash which was not a seen-hash" ); my %h40 = ( abel => 2, baker => 1, camera => 1, delta => 1, edward => 1, fargo => 1, golfer => 1, ); my %h41 = ( baker => 1, camera => 1, delta => 2, edward => 1, fargo => 1, golfer => 1, hilton => 0, ); eval { $lc = List::Compare->new(\%h40, \%h41); }; like($@, qr/Values in a 'seen-hash' may only be positive integers/s, "Got expected error message for right-hand hash which was not a seen-hash" ); like($@, qr/Second hash in arguments/s, "Got expected error message for right-hand hash which was not a seen-hash" ); like($@, qr/Key:\s+hilton\s+Value:\s+0/s, "Got expected error message for right-hand hash which was not a seen-hash" ); eval { $lc = List::Compare->new('-a', \%h40, \%h41); }; like($@, qr/Values in a 'seen-hash' must be numeric/s, "Got expected error message for right-hand hash which was not a seen-hash" ); like($@, qr/Second hash in arguments/s, "Got expected error message for right-hand hash which was not a seen-hash" ); like($@, qr/Key:\s+hilton\s+Value:\s+0/s, "Got expected error message for right-hand hash which was not a seen-hash" ); List-Compare-0.53/t/02_oo_lists_dual_reg_unsorted.t0000755000175000017500000003372612465263760022152 0ustar jkeenanjkeenan# perl #$Id$ # 02_oo_lists_dual_reg_unsorted.t use strict; use Test::More tests => 103; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :arrays :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; ########## BELOW: Tests for '-u' option ########## ### new ### my $lcu = List::Compare->new('-u', \@a0, \@a1); ok($lcu, "constructor returned true value"); %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton ); @unpred = qw| icon jerky |; @union = $lcu->get_union; $seen{$_}++ foreach (@union); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); $union_ref = $lcu->get_union_ref; $seen{$_}++ foreach (@{$union_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer ); @unpred = qw| abel hilton icon jerky |; @intersection = $lcu->get_intersection; $seen{$_}++ foreach (@intersection); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); $intersection_ref = $lcu->get_intersection_ref; $seen{$_}++ foreach (@{$intersection_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); { my ($rv, $stdout, $stderr); capture( sub { @shared = $lcu->get_shared; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@shared); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); { my ($rv, $stdout, $stderr); capture( sub { $shared_ref = $lcu->get_shared_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$shared_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); %pred = map {$_, 1} qw( abel ); @unpred = qw| baker camera delta edward fargo golfer hilton icon jerky |; @unique = $lcu->get_unique; $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcu->get_unique_ref; $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @unique = $lcu->get_Lonly; $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcu->get_Lonly_ref; $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @unique = $lcu->get_Aonly; $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcu->get_Aonly_ref; $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ 'abel' ], [ 'hilton' ], ); $unique_all_ref = $lcu->get_unique_all(); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_unique_all()"); %pred = map {$_, 1} qw( hilton ); @unpred = qw| abel baker camera delta edward fargo golfer icon jerky |; @complement = $lcu->get_complement; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcu->get_complement_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @complement = $lcu->get_Ronly; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcu->get_Ronly_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @complement = $lcu->get_Bonly; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcu->get_Bonly_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ qw( hilton ) ], [ qw( abel ) ], ); $complement_all_ref = $lcu->get_complement_all(); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %pred = map {$_, 1} qw( abel hilton ); @unpred = qw| baker camera delta edward fargo golfer icon jerky |; @symmetric_difference = $lcu->get_symmetric_difference; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_symmetric_difference_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcu->get_symdiff; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_symdiff_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcu->get_LorRonly; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_LorRonly_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcu->get_AorBonly; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_AorBonly_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel hilton ); @unpred = qw| baker camera delta edward fargo golfer icon jerky |; { my ($rv, $stdout, $stderr); capture( sub { @nonintersection = $lcu->get_nonintersection; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@nonintersection); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); { my ($rv, $stdout, $stderr); capture( sub { $nonintersection_ref = $lcu->get_nonintersection_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$nonintersection_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); %pred = ( abel => 2, baker => 2, camera => 2, delta => 3, edward => 2, fargo => 2, golfer => 2, hilton => 1, ); @unpred = qw| icon jerky |; @bag = $lcu->get_bag; $seen{$_}++ foreach (@bag); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $bag_ref = $lcu->get_bag_ref; $seen{$_}++ foreach (@{$bag_ref}); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $LR = $lcu->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); $LR = $lcu->is_AsubsetB; ok(! $LR, "Got expected subset relationship"); $RL = $lcu->is_RsubsetL; ok(! $RL, "Got expected subset relationship"); $RL = $lcu->is_BsubsetA; ok(! $RL, "Got expected subset relationship"); $eqv = $lcu->is_LequivalentR; ok(! $eqv, "Got expected equivalent relationship"); $eqv = $lcu->is_LeqvlntR; ok(! $eqv, "Got expected equivalent relationship"); $disj = $lcu->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcu->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcu->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } ok(wrap_is_member_which( $lcu, $test_members_which, ), "is_member_which() returned all expected values"); ok(wrap_is_member_which_ref( $lcu, $test_members_which, ), "is_member_which_ref() returned all expected values"); @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); $memb_hash_ref = $lcu->are_members_which( \@args ); ok(wrap_are_members_which( $memb_hash_ref, $test_members_which, ), "are_members_which() returned all expected value"); ok(wrap_is_member_any( $lcu, $test_members_any, ), "is_member_any() returned all expected values"); $memb_hash_ref = $lcu->are_members_any( \@args ); ok(wrap_are_members_any( $memb_hash_ref, $test_members_any, ), "are_members_any() returned all expected values"); $vers = $lcu->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lcu_s = List::Compare->new('-u', \@a2, \@a3); ok($lcu_s, "constructor returned true value"); $LR = $lcu_s->is_LsubsetR; ok(! $LR, "non-subset correctly determined"); $LR = $lcu_s->is_AsubsetB; ok(! $LR, "non-subset correctly determined"); $RL = $lcu_s->is_RsubsetL; ok($RL, "subset correctly determined"); $RL = $lcu_s->is_BsubsetA; ok($RL, "subset correctly determined"); $eqv = $lcu_s->is_LequivalentR; ok(! $eqv, "non-equivalence correctly determined"); $eqv = $lcu_s->is_LeqvlntR; ok(! $eqv, "non-equivalence correctly determined"); $disj = $lcu_s->is_LdisjointR; ok(! $disj, "non-disjoint correctly determined"); ### new ### my $lcu_e = List::Compare->new('-u', \@a3, \@a4); ok($lcu_e, "constructor returned true value"); $eqv = $lcu_e->is_LequivalentR; ok($eqv, "Got expected equivalent relationship"); $eqv = $lcu_e->is_LeqvlntR; ok($eqv, "Got expected equivalent relationship"); $disj = $lcu_e->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); ### new ### my $lcu_dj = List::Compare->new('-u', \@a4, \@a8); ok($lcu_dj, "constructor returned true value"); ok(0 == $lcu_dj->get_intersection, "no intersection, as expected"); ok(0 == scalar(@{$lcu_dj->get_intersection_ref}), "no intersection, as expected"); $disj = $lcu_dj->is_LdisjointR; ok($disj, "disjoint correctly determined"); ########## BELOW: Tests for '--unsorted' option ########## my $lcun = List::Compare->new('--unsorted', \@a0, \@a1); ok($lcun, "constructor returned true value"); my $lcun_s = List::Compare->new('--unsorted', \@a2, \@a3); ok($lcun_s, "constructor returned true value"); my $lcun_e = List::Compare->new('--unsorted', \@a3, \@a4); ok($lcun_e, "constructor returned true value"); List-Compare-0.53/t/16_oo_lists_alt_mult_acc_unsorted.t0000755000175000017500000004357312465263760023025 0ustar jkeenanjkeenan# perl #$Id$ # t/16_oo_lists_alt_mult_acc_unsorted.t use strict; use Test::More tests => 110; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :arrays :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; ### new ### my $lcmu = List::Compare->new( { unsorted =>1, accelerated => 1, lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], } ); ok($lcmu, "List::Compare constructor returned true value"); %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton icon jerky ); @unpred = qw| kappa |; @union = $lcmu->get_union; $seen{$_}++ foreach (@union); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); $union_ref = $lcmu->get_union_ref; $seen{$_}++ foreach (@{$union_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer hilton icon ); @unpred = qw| abel jerky |; @shared = $lcmu->get_shared; $seen{$_}++ foreach (@shared); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); $shared_ref = $lcmu->get_shared_ref; $seen{$_}++ foreach (@{$shared_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( fargo golfer ); @unpred = qw| abel baker camera delta edward hilton icon jerky |; @intersection = $lcmu->get_intersection; $seen{$_}++ foreach (@intersection); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); $intersection_ref = $lcmu->get_intersection_ref; $seen{$_}++ foreach (@{$intersection_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( jerky ); @unpred = qw| abel baker camera delta edward fargo golfer hilton icon |; @unique = $lcmu->get_unique(2); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcmu->get_unique_ref(2); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @unique = $lcmu->get_Lonly(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $unique_ref = $lcmu->get_Lonly_ref(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { @unique = $lcmu->get_Aonly(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $unique_ref = $lcmu->get_Aonly_ref(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); @pred = ( [ 'abel' ], [ ], [ 'jerky' ], [ ], [ ], ); $unique_all_ref = $lcmu->get_unique_all(); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_unique_all()"); %pred = map {$_, 1} qw( abel icon jerky ); @unpred = qw| baker camera delta edward fargo golfer hilton |; @complement = $lcmu->get_complement(1); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcmu->get_complement_ref(1); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @complement = $lcmu->get_Bonly(1); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $complement_ref = $lcmu->get_Bonly_ref(1); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); %pred = map {$_, 1} qw( hilton icon jerky ); @unpred = qw| abel baker camera delta edward fargo golfer |; @complement = $lcmu->get_complement; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcmu->get_complement_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @complement = $lcmu->get_Ronly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $complement_ref = $lcmu->get_Ronly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { @complement = $lcmu->get_Bonly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $complement_ref = $lcmu->get_Bonly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); %pred = map {$_, 1} qw( abel jerky ); @unpred = qw| baker camera delta edward fargo golfer hilton icon |; @symmetric_difference = $lcmu->get_symmetric_difference; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcmu->get_symmetric_difference_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcmu->get_symdiff; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcmu->get_symdiff_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @symmetric_difference = $lcmu->get_LorRonly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } %seen = (); { my ($stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcmu->get_LorRonly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); } %seen = (); { my ($stdout, $stderr); capture( sub { @symmetric_difference = $lcmu->get_AorBonly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } %seen = (); { my ($stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcmu->get_AorBonly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); } %seen = (); @pred = ( [ qw( hilton icon jerky ) ], [ qw( abel icon jerky ) ], [ qw( abel baker camera delta edward ) ], [ qw( abel baker camera delta edward jerky ) ], [ qw( abel baker camera delta edward jerky ) ], ); $complement_all_ref = $lcmu->get_complement_all(); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %pred = map {$_, 1} qw( abel baker camera delta edward hilton icon jerky ); @unpred = qw| fargo golfer |; @nonintersection = $lcmu->get_nonintersection; $seen{$_}++ foreach (@nonintersection); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); $nonintersection_ref = $lcmu->get_nonintersection_ref; $seen{$_}++ foreach (@{$nonintersection_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); %pred = ( abel => 2, baker => 2, camera => 2, delta => 3, edward => 2, fargo => 6, golfer => 5, hilton => 4, icon => 5, jerky => 1, ); @unpred = qw| kappa |; @bag = $lcmu->get_bag; $seen{$_}++ foreach (@bag); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $bag_ref = $lcmu->get_bag_ref; $seen{$_}++ foreach (@{$bag_ref}); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $LR = $lcmu->is_LsubsetR(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcmu->is_AsubsetB(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcmu->is_LsubsetR(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcmu->is_AsubsetB(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcmu->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcmu->is_RsubsetL; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcmu->is_BsubsetA; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } $eqv = $lcmu->is_LequivalentR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcmu->is_LeqvlntR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcmu->is_LequivalentR(2,4); ok(! $eqv, "Got expected equivalence relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcmu->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcmu->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); is_deeply( all_is_member_which( $lcmu, \@args), $test_member_which_mult, "is_member_which() returned all expected values"); is_deeply( all_is_member_which_ref( $lcmu, \@args), $test_member_which_mult, "is_member_which_ref() returned all expected values"); $memb_hash_ref = $lcmu->are_members_which( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); is_deeply($memb_hash_ref, $test_members_which_mult, "are_members_which() returned all expected values"); is_deeply( all_is_member_any( $lcmu, \@args), $test_member_any_mult, "is_member_which() returned all expected values"); $memb_hash_ref = $lcmu->are_members_any( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); is_deeply($memb_hash_ref, $test_members_any_mult, "are_members_any() returned all expected values"); $vers = $lcmu->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lcmu_dj = List::Compare->new( { unsorted =>1, accelerated => 1, lists => [ \@a0, \@a1, \@a2, \@a3, \@a4, \@a8 ], } ); ok($lcmu_dj, "List::Compare constructor returned true value"); $disj = $lcmu_dj->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); $disj = $lcmu_dj->is_LdisjointR(2,3); ok(! $disj, "Got expected disjoint relationship"); $disj = $lcmu_dj->is_LdisjointR(4,5); ok($disj, "Got expected disjoint relationship"); ########## BELOW: Test for '--unsorted' option ########## my $lcmuna = List::Compare->new( { unsorted =>1, accelerated => 1, lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], } ); ok($lcmuna, "List::Compare constructor returned true value"); List-Compare-0.53/t/47_func_hashes_alt_mult_sorted.t0000755000175000017500000002000112465263760022270 0ustar jkeenanjkeenan# perl #$Id$ # 47_func_hashes_alt_mult_sorted.t use strict; use Test::More tests => 43; use List::Compare::Functional qw(:originals :aliases); use lib ("./t"); use Test::ListCompareSpecial qw( :seen :func_wrap :hashes :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref); my @args; @pred = qw(abel baker camera delta edward fargo golfer hilton icon jerky); @union = get_union( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ] } ); is_deeply( \@union, \@pred, "Got expected union"); $union_ref = get_union_ref( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ] } ); is_deeply( $union_ref, \@pred, "Got expected union"); @pred = qw(baker camera delta edward fargo golfer hilton icon); @shared = get_shared( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ] } ); is_deeply( \@shared, \@pred, "Got expected shared"); $shared_ref = get_shared_ref( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ] } ); is_deeply( $shared_ref, \@pred, "Got expected shared"); @pred = qw(fargo golfer); @intersection = get_intersection( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ] } ); is_deeply(\@intersection, \@pred, "Got expected intersection"); $intersection_ref = get_intersection_ref( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ] } ); is_deeply($intersection_ref, \@pred, "Got expected intersection"); @pred = qw( jerky ); @unique = get_unique( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], item => 2 } ); is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = get_unique_ref( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], item => 2 } ); is_deeply($unique_ref, \@pred, "Got expected unique"); @pred = qw( abel ); @unique = get_unique( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ] } ); is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = get_unique_ref( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ] } ); is_deeply($unique_ref, \@pred, "Got expected unique"); @pred = ( [ 'abel' ], [ ], [ 'jerky' ], [ ], [ ], ); $unique_all_ref = get_unique_all( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ] } ); is_deeply($unique_all_ref, [ @pred ], "Got expected values for get_unique_all()"); @pred = qw( abel icon jerky ); @complement = get_complement({ lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], item => 1 } ); is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = get_complement_ref({ lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], item => 1 } ); is_deeply($complement_ref, \@pred, "Got expected complement"); @pred = qw ( hilton icon jerky ); @complement = get_complement( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ] } ); is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = get_complement_ref( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ] } ); is_deeply($complement_ref, \@pred, "Got expected complement"); @pred = ( [ qw( hilton icon jerky ) ], [ qw( abel icon jerky ) ], [ qw( abel baker camera delta edward ) ], [ qw( abel baker camera delta edward jerky ) ], [ qw( abel baker camera delta edward jerky ) ], ); $complement_all_ref = get_complement_all( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ] } ); is_deeply($complement_all_ref, [ @pred ], "Got expected values for get_complement_all()"); @pred = qw( abel jerky ); @symmetric_difference = get_symmetric_difference( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ] } ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = get_symmetric_difference_ref( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ] } ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = get_symdiff( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ] } ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = get_symdiff_ref( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ] } ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @pred = qw( abel baker camera delta edward hilton icon jerky ); @nonintersection = get_nonintersection( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ] } ); is_deeply( \@nonintersection, \@pred, "Got expected nonintersection"); $nonintersection_ref = get_nonintersection_ref( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ] } ); is_deeply($nonintersection_ref, \@pred, "Got expected nonintersection"); @pred = qw( abel abel baker baker camera camera delta delta delta edward edward fargo fargo fargo fargo fargo fargo golfer golfer golfer golfer golfer hilton hilton hilton hilton icon icon icon icon icon jerky ); @bag = get_bag( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ] } ); is_deeply(\@bag, \@pred, "Got expected bag"); $bag_ref = get_bag_ref( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ] } ); is_deeply($bag_ref, \@pred, "Got expected bag"); $LR = is_LsubsetR( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], pair => [ 3,2 ] } ); ok($LR, "Got expected subset relationship"); $LR = is_LsubsetR( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], pair => [ 2,3 ] } ); ok(! $LR, "Got expected subset relationship"); $LR = is_LsubsetR( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ] } ); ok(! $LR, "Got expected subset relationship"); $eqv = is_LequivalentR( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], pair => [ 3,4 ] } ); ok($eqv, "Got expected equivalence relationship"); $eqv = is_LeqvlntR( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], pair => [ 3,4 ] } ); ok($eqv, "Got expected equivalence relationship"); $eqv = is_LequivalentR( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], pair => [ 2,4 ] } ); ok(! $eqv, "Got expected equivalence relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = print_subset_chart( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ] } ); }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = print_equivalence_chart( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ] } ); }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); is_deeply(func_all_is_member_which_alt( [ \%h0, \%h1, \%h2, \%h3, \%h4 ], \@args ), $test_member_which_mult, "is_member_which() returned all expected values"); is_deeply(func_all_is_member_which_ref_alt( [ \%h0, \%h1, \%h2, \%h3, \%h4 ], \@args ), $test_member_which_mult, "is_member_which_ref() returned all expected values"); $memb_hash_ref = are_members_which( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], items => \@args } ); is_deeply($memb_hash_ref, $test_members_which_mult, "are_members_which() returned all expected values"); is_deeply(func_all_is_member_any_alt( [ \%h0, \%h1, \%h2, \%h3, \%h4 ], \@args ), $test_member_any_mult, "is_member_any() returned all expected values"); $memb_hash_ref = are_members_any( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], items => \@args, } ); ok(func_wrap_are_members_any( $memb_hash_ref, $test_members_any_mult, ), "are_members_any() returned all expected values"); $vers = get_version; ok($vers, "get_version() returned true value"); $disj = is_LdisjointR( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4, \%h8 ] } ); ok(! $disj, "Got expected disjoint relationship"); $disj = is_LdisjointR( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4, \%h8 ], pair => [ 2,3 ] } ); ok(! $disj, "Got expected disjoint relationship"); $disj = is_LdisjointR( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4, \%h8 ], pair => [ 4,5 ] } ); ok($disj, "Got expected disjoint relationship"); List-Compare-0.53/t/39_func_lists_alt_mult_sorted.t0000755000175000017500000002000012465263760022153 0ustar jkeenanjkeenan# perl #$Id$ # 39_func_lists_alt_mult_sorted.t use strict; use Test::More tests => 43; use List::Compare::Functional qw(:originals :aliases); use lib ("./t"); use Test::ListCompareSpecial qw( :seen :func_wrap :arrays :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref); my @args; @pred = qw(abel baker camera delta edward fargo golfer hilton icon jerky); @union = get_union( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ] } ); is_deeply( \@union, \@pred, "Got expected union"); $union_ref = get_union_ref( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ] } ); is_deeply( $union_ref, \@pred, "Got expected union"); @pred = qw(baker camera delta edward fargo golfer hilton icon); @shared = get_shared( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ] } ); is_deeply( \@shared, \@pred, "Got expected shared"); $shared_ref = get_shared_ref( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ] } ); is_deeply( $shared_ref, \@pred, "Got expected shared"); @pred = qw(fargo golfer); @intersection = get_intersection( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ] } ); is_deeply(\@intersection, \@pred, "Got expected intersection"); $intersection_ref = get_intersection_ref( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ] } ); is_deeply($intersection_ref, \@pred, "Got expected intersection"); @pred = qw( jerky ); @unique = get_unique( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], item => 2 } ); is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = get_unique_ref( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], item => 2 } ); is_deeply($unique_ref, \@pred, "Got expected unique"); @pred = qw( abel ); @unique = get_unique( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ] } ); is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = get_unique_ref( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ] } ); is_deeply($unique_ref, \@pred, "Got expected unique"); @pred = ( [ 'abel' ], [ ], [ 'jerky' ], [ ], [ ], ); $unique_all_ref = get_unique_all( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ] } ); is_deeply($unique_all_ref, [ @pred ], "Got expected values for get_unique_all()"); @pred = qw( abel icon jerky ); @complement = get_complement({ lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], item => 1 } ); is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = get_complement_ref({ lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], item => 1 } ); is_deeply($complement_ref, \@pred, "Got expected complement"); @pred = qw ( hilton icon jerky ); @complement = get_complement( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ] } ); is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = get_complement_ref( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ] } ); is_deeply($complement_ref, \@pred, "Got expected complement"); @pred = ( [ qw( hilton icon jerky ) ], [ qw( abel icon jerky ) ], [ qw( abel baker camera delta edward ) ], [ qw( abel baker camera delta edward jerky ) ], [ qw( abel baker camera delta edward jerky ) ], ); $complement_all_ref = get_complement_all( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ] } ); is_deeply($complement_all_ref, [ @pred ], "Got expected values for get_complement_all()"); @pred = qw( abel jerky ); @symmetric_difference = get_symmetric_difference( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ] } ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = get_symmetric_difference_ref( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ] } ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = get_symdiff( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ] } ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = get_symdiff_ref( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ] } ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @pred = qw( abel baker camera delta edward hilton icon jerky ); @nonintersection = get_nonintersection( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ] } ); is_deeply( \@nonintersection, \@pred, "Got expected nonintersection"); $nonintersection_ref = get_nonintersection_ref( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ] } ); is_deeply($nonintersection_ref, \@pred, "Got expected nonintersection"); @pred = qw( abel abel baker baker camera camera delta delta delta edward edward fargo fargo fargo fargo fargo fargo golfer golfer golfer golfer golfer hilton hilton hilton hilton icon icon icon icon icon jerky ); @bag = get_bag( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ] } ); is_deeply(\@bag, \@pred, "Got expected bag"); $bag_ref = get_bag_ref( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ] } ); is_deeply($bag_ref, \@pred, "Got expected bag"); $LR = is_LsubsetR( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], pair => [ 3,2 ] } ); ok($LR, "Got expected subset relationship"); $LR = is_LsubsetR( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], pair => [ 2,3 ] } ); ok(! $LR, "Got expected subset relationship"); $LR = is_LsubsetR( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ] } ); ok(! $LR, "Got expected subset relationship"); $eqv = is_LequivalentR( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], pair => [ 3,4 ] } ); ok($eqv, "Got expected equivalence relationship"); $eqv = is_LeqvlntR( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], pair => [ 3,4 ] } ); ok($eqv, "Got expected equivalence relationship"); $eqv = is_LequivalentR( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], pair => [ 2,4 ] } ); ok(! $eqv, "Got expected equivalence relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = print_subset_chart( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ] } ); }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = print_equivalence_chart( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ] } ); }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); is_deeply(func_all_is_member_which_alt( [ \@a0, \@a1, \@a2, \@a3, \@a4 ], \@args ), $test_member_which_mult, "is_member_which() returned all expected values"); is_deeply(func_all_is_member_which_ref_alt( [ \@a0, \@a1, \@a2, \@a3, \@a4 ], \@args ), $test_member_which_mult, "is_member_which_ref() returned all expected values"); $memb_hash_ref = are_members_which( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], items => \@args } ); is_deeply($memb_hash_ref, $test_members_which_mult, "are_members_which() returned all expected values"); is_deeply(func_all_is_member_any_alt( [ \@a0, \@a1, \@a2, \@a3, \@a4 ], \@args ), $test_member_any_mult, "is_member_any() returned all expected values"); $memb_hash_ref = are_members_any( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], items => \@args, } ); ok(func_wrap_are_members_any( $memb_hash_ref, $test_members_any_mult, ), "are_members_any() returned all expected values"); $vers = get_version; ok($vers, "get_version() returned true value"); $disj = is_LdisjointR( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4, \@a8 ] } ); ok(! $disj, "Got expected disjoint relationship"); $disj = is_LdisjointR( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4, \@a8 ], pair => [ 2,3 ] } ); ok(! $disj, "Got expected disjoint relationship"); $disj = is_LdisjointR( { lists => [ \@a0, \@a1, \@a2, \@a3, \@a4, \@a8 ], pair => [ 4,5 ] } ); ok($disj, "Got expected disjoint relationship"); List-Compare-0.53/t/41_func_hashes_dual_sorted.t0000755000175000017500000001464312465263760021405 0ustar jkeenanjkeenan# perl #$Id$ # 41_func_hashes_dual_sorted.t use strict; use Test::More tests => 46; use List::Compare::Functional qw(:originals :aliases); use lib ("./t"); use Test::ListCompareSpecial qw( :seen :func_wrap :hashes :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref); my @args; @pred = qw(abel baker camera delta edward fargo golfer hilton); @union = get_union( [ \%h0, \%h1 ] ); is_deeply( \@union, \@pred, "Got expected union"); $union_ref = get_union_ref( [ \%h0, \%h1 ] ); is_deeply( $union_ref, \@pred, "Got expected union"); @pred = qw( baker camera delta edward fargo golfer ); @shared = get_shared( [ \%h0, \%h1 ] ); is_deeply( \@shared, \@pred, "Got expected shared"); $shared_ref = get_shared_ref( [ \%h0, \%h1 ] ); is_deeply( $shared_ref, \@pred, "Got expected shared"); @pred = qw( baker camera delta edward fargo golfer ); @intersection = get_intersection( [ \%h0, \%h1 ] ); is_deeply(\@intersection, \@pred, "Got expected intersection"); $intersection_ref = get_intersection_ref( [ \%h0, \%h1 ] ); is_deeply($intersection_ref, \@pred, "Got expected intersection"); @pred = qw( abel ); @unique = get_unique( [ \%h0, \%h1 ] ); is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = get_unique_ref( [ \%h0, \%h1 ] ); is_deeply($unique_ref, \@pred, "Got expected unique"); @pred = ( [ 'abel' ], [ 'hilton' ], ); $unique_all_ref = get_unique_all( [ \%h0, \%h1 ] ); is_deeply($unique_all_ref, [ @pred ], "Got expected values for get_unique_all()"); @pred = qw ( hilton ); @complement = get_complement( [ \%h0, \%h1 ] ); is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = get_complement_ref( [ \%h0, \%h1 ] ); is_deeply($complement_ref, \@pred, "Got expected complement"); @pred = ( [ qw( hilton ) ], [ qw( abel ) ], ); $complement_all_ref = get_complement_all( [ \%h0, \%h1 ] ); is_deeply($complement_all_ref, [ @pred ], "Got expected values for get_complement_all()"); @pred = qw( abel hilton ); @symmetric_difference = get_symmetric_difference( [ \%h0, \%h1 ] ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = get_symmetric_difference_ref( [ \%h0, \%h1 ] ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = get_symdiff( [ \%h0, \%h1 ] ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = get_symdiff_ref( [ \%h0, \%h1 ] ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @pred = qw( abel hilton ); @nonintersection = get_nonintersection( [ \%h0, \%h1 ] ); is_deeply(\@nonintersection, \@pred, "Got expected nonintersection"); $nonintersection_ref = get_nonintersection_ref( [ \%h0, \%h1 ] ); is_deeply($nonintersection_ref, \@pred, "Got expected nonintersection"); @pred = qw( abel abel baker baker camera camera delta delta delta edward edward fargo fargo golfer golfer hilton ); @bag = get_bag( [ \%h0, \%h1 ] ); is_deeply(\@bag, \@pred, "Got expected bag"); $bag_ref = get_bag_ref( [ \%h0, \%h1 ] ); is_deeply($bag_ref, \@pred, "Got expected bag"); $LR = is_LsubsetR( [ \%h0, \%h1 ] ); ok(! $LR, "Got expected subset relationship"); $RL = is_RsubsetL( [ \%h0, \%h1 ] ); ok(! $RL, "Got expected subset relationship"); $eqv = is_LequivalentR( [ \%h0, \%h1 ] ); ok(! $eqv, "Got expected equivalent relationship"); $eqv = is_LeqvlntR( [ \%h0, \%h1 ] ); ok(! $eqv, "Got expected equivalent relationship"); $disj = is_LdisjointR( [ \%h0, \%h1 ] ); ok(! $disj, "Got expected disjoint relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = print_subset_chart( [ \%h0, \%h1 ] ); }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = print_equivalence_chart( [ \%h0, \%h1 ] ); }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); is_deeply(func_all_is_member_which( [ \%h0, \%h1 ], \@args ), $test_member_which_dual, "is_member_which() returned all expected values"); is_deeply(func_all_is_member_which_ref( [ \%h0, \%h1 ], \@args ), $test_member_which_dual, "is_member_which() returned all expected values"); $memb_hash_ref = are_members_which( [ \%h0, \%h1 ] , \@args ); ok(func_wrap_are_members_which( $memb_hash_ref, $test_members_which, ), "are_members_which() returned all expected values"); is_deeply(func_all_is_member_any( [ \%h0, \%h1 ], \@args ), $test_member_any_dual, "is_member_any() returned all expected values"); $memb_hash_ref = are_members_any( [ \%h0, \%h1 ], \@args ); ok(func_wrap_are_members_any( $memb_hash_ref, $test_members_any, ), "are_members_any() returned all expected values"); $vers = get_version; ok($vers, "get_version() returned true value"); $LR = is_LsubsetR( [ \%h2, \%h3 ] ); ok(! $LR, "non-subset correctly determined"); $RL = is_RsubsetL( [ \%h2, \%h3 ] ); ok($RL, "subset correctly determined"); $eqv = is_LequivalentR( [ \%h2, \%h3 ] ); ok(! $eqv, "non-equivalence correctly determined"); $eqv = is_LeqvlntR( [ \%h2, \%h3 ] ); ok(! $eqv, "non-equivalence correctly determined"); $disj = is_LdisjointR( [ \%h2, \%h3 ] ); ok(! $disj, "non-disjoint correctly determined"); $eqv = is_LequivalentR( [ \%h3, \%h4 ] ); ok($eqv, "equivalence correctly determined"); $eqv = is_LeqvlntR( [ \%h3, \%h4 ] ); ok($eqv, "equivalence correctly determined"); $disj = is_LdisjointR( [ \%h3, \%h4 ] ); ok(! $disj, "non-disjoint correctly determined"); ok(0 == get_intersection( [ \%h4, \%h8 ] ), "no intersection, as expected"); ok(0 == scalar(@{get_intersection_ref( [ \%h4, \%h8 ] )}), "no intersection, as expected"); $disj = is_LdisjointR( [ \%h4, \%h8 ] ); ok($disj, "disjoint correctly determined"); List-Compare-0.53/t/30_oo_hashes_alt_mult_reg_unsorted.t0000755000175000017500000004324312465263760023157 0ustar jkeenanjkeenan# perl #$Id$ # 30_oo_hashes_alt_mult_reg_unsorted.t use strict; use Test::More tests => 110; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :hashes :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; ### new ### my $lcmu = List::Compare->new( { unsorted => 1, lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], } ); ok($lcmu, "List::Compare constructor returned true value"); %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton icon jerky ); @unpred = qw| kappa |; @union = $lcmu->get_union; $seen{$_}++ foreach (@union); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); $union_ref = $lcmu->get_union_ref; $seen{$_}++ foreach (@{$union_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer hilton icon ); @unpred = qw| abel jerky |; @shared = $lcmu->get_shared; $seen{$_}++ foreach (@shared); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); $shared_ref = $lcmu->get_shared_ref; $seen{$_}++ foreach (@{$shared_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( fargo golfer ); @unpred = qw| abel baker camera delta edward hilton icon jerky |; @intersection = $lcmu->get_intersection; $seen{$_}++ foreach (@intersection); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); $intersection_ref = $lcmu->get_intersection_ref; $seen{$_}++ foreach (@{$intersection_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( jerky ); @unpred = qw| abel baker camera delta edward fargo golfer hilton icon |; @unique = $lcmu->get_unique(2); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcmu->get_unique_ref(2); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @unique = $lcmu->get_Lonly(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $unique_ref = $lcmu->get_Lonly_ref(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { @unique = $lcmu->get_Aonly(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $unique_ref = $lcmu->get_Aonly_ref(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); @pred = ( [ 'abel' ], [ ], [ 'jerky' ], [ ], [ ], ); $unique_all_ref = $lcmu->get_unique_all(); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %pred = map {$_, 1} qw( abel icon jerky ); @unpred = qw| baker camera delta edward fargo golfer hilton |; @complement = $lcmu->get_complement(1); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcmu->get_complement_ref(1); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @complement = $lcmu->get_Bonly(1); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $complement_ref = $lcmu->get_Bonly_ref(1); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); %pred = map {$_, 1} qw( hilton icon jerky ); @unpred = qw| abel baker camera delta edward fargo golfer |; @complement = $lcmu->get_complement; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcmu->get_complement_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @complement = $lcmu->get_Ronly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $complement_ref = $lcmu->get_Ronly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { @complement = $lcmu->get_Bonly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $complement_ref = $lcmu->get_Bonly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); %pred = map {$_, 1} qw( abel jerky ); @unpred = qw| baker camera delta edward fargo golfer hilton icon |; @symmetric_difference = $lcmu->get_symmetric_difference; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcmu->get_symmetric_difference_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcmu->get_symdiff; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcmu->get_symdiff_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @symmetric_difference = $lcmu->get_LorRonly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } %seen = (); { my ($stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcmu->get_LorRonly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); } %seen = (); { my ($stdout, $stderr); capture( sub { @symmetric_difference = $lcmu->get_AorBonly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } %seen = (); { my ($stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcmu->get_AorBonly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); } %seen = (); @pred = ( [ qw( hilton icon jerky ) ], [ qw( abel icon jerky ) ], [ qw( abel baker camera delta edward ) ], [ qw( abel baker camera delta edward jerky ) ], [ qw( abel baker camera delta edward jerky ) ], ); $complement_all_ref = $lcmu->get_complement_all(); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %seen = (); %pred = map {$_, 1} qw( abel baker camera delta edward hilton icon jerky ); @unpred = qw| fargo golfer |; @nonintersection = $lcmu->get_nonintersection; $seen{$_}++ foreach (@nonintersection); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); $nonintersection_ref = $lcmu->get_nonintersection_ref; $seen{$_}++ foreach (@{$nonintersection_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); %pred = ( abel => 2, baker => 2, camera => 2, delta => 3, edward => 2, fargo => 6, golfer => 5, hilton => 4, icon => 5, jerky => 1, ); @unpred = qw| kappa |; @bag = $lcmu->get_bag; $seen{$_}++ foreach (@bag); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $bag_ref = $lcmu->get_bag_ref; $seen{$_}++ foreach (@{$bag_ref}); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $LR = $lcmu->is_LsubsetR(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcmu->is_AsubsetB(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcmu->is_LsubsetR(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcmu->is_AsubsetB(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcmu->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcmu->is_RsubsetL; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcmu->is_BsubsetA; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } $eqv = $lcmu->is_LequivalentR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcmu->is_LeqvlntR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcmu->is_LequivalentR(2,4); ok(! $eqv, "Got expected equivalence relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcmu->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcmu->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); is_deeply( all_is_member_which( $lcmu, \@args), $test_member_which_mult, "is_member_which() returned all expected values"); is_deeply( all_is_member_which_ref( $lcmu, \@args), $test_member_which_mult, "is_member_which_ref() returned all expected values"); $memb_hash_ref = $lcmu->are_members_which( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); is_deeply($memb_hash_ref, $test_members_which_mult, "are_members_which() returned all expected values"); is_deeply( all_is_member_any( $lcmu, \@args), $test_member_any_mult, "is_member_which() returned all expected values"); $memb_hash_ref = $lcmu->are_members_any( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); is_deeply($memb_hash_ref, $test_members_any_mult, "are_members_any() returned all expected values"); $vers = $lcmu->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lcmu_dj = List::Compare->new( { unsorted => 1, lists => [ \%h0, \%h1, \%h2, \%h3, \%h4, \%h8 ], } ); ok($lcmu_dj, "List::Compare constructor returned true value"); $disj = $lcmu_dj->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); $disj = $lcmu_dj->is_LdisjointR(2,3); ok(! $disj, "Got expected disjoint relationship"); $disj = $lcmu_dj->is_LdisjointR(4,5); ok($disj, "Got expected disjoint relationship"); ok($lcmu_dj, "List::Compare constructor returned true value"); List-Compare-0.53/t/34_func_lists_dual_unsorted.t0000755000175000017500000001720112465263760021626 0ustar jkeenanjkeenan# perl #$Id$ # 34_func_lists_dual_unsorted.t use strict; use Test::More tests => 42; use List::Compare::Functional qw(:originals :aliases); use lib ("./t"); use Test::ListCompareSpecial qw( :seen :func_wrap :arrays :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref); my @args; %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton ); @unpred = qw| icon jerky |; @union = get_union( '-u', [ \@a0, \@a1 ] ); $seen{$_}++ foreach (@union); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); $union_ref = get_union_ref( '-u', [ \@a0, \@a1 ] ); $seen{$_}++ foreach (@{$union_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer ); @unpred = qw| abel hilton icon jerky |; @shared = get_shared( '-u', [ \@a0, \@a1 ] ); $seen{$_}++ foreach (@shared); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); $shared_ref = get_shared_ref( '-u', [ \@a0, \@a1 ] ); $seen{$_}++ foreach (@{$shared_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer ); @unpred = qw| abel hilton icon jerky |; @intersection = get_intersection( '-u', [ \@a0, \@a1 ] ); $seen{$_}++ foreach (@intersection); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); $intersection_ref = get_intersection_ref( '-u', [ \@a0, \@a1 ] ); $seen{$_}++ foreach (@{$intersection_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel ); @unpred = qw| baker camera delta edward fargo golfer hilton icon jerky |; @unique = get_unique( '-u', [ \@a0, \@a1 ] ); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = get_unique_ref( '-u', [ \@a0, \@a1 ] ); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ 'abel' ], [ 'hilton' ], ); $unique_all_ref = get_unique_all( '-u', [ \@a0, \@a1 ] ); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_unique_all()"); %pred = map {$_, 1} qw( hilton ); @unpred = qw| abel baker camera delta edward fargo golfer icon jerky |; @complement = get_complement( '-u', [ \@a0, \@a1 ] ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = get_complement_ref( '-u', [ \@a0, \@a1 ] ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ qw( hilton ) ], [ qw( abel ) ], ); $complement_all_ref = get_complement_all( '-u', [ \@a0, \@a1 ] ); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %pred = map {$_, 1} qw( abel hilton ); @unpred = qw| baker camera delta edward fargo golfer icon jerky |; @symmetric_difference = get_symmetric_difference( '-u', [ \@a0, \@a1 ] ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = get_symmetric_difference_ref( '-u', [ \@a0, \@a1 ] ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = get_symdiff( '-u', [ \@a0, \@a1 ] ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = get_symdiff_ref( '-u', [ \@a0, \@a1 ] ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel hilton ); @unpred = qw| baker camera delta edward fargo golfer icon jerky |; @nonintersection = get_nonintersection( '-u', [ \@a0, \@a1 ] ); $seen{$_}++ foreach (@nonintersection); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); $nonintersection_ref = get_nonintersection_ref( '-u', [ \@a0, \@a1 ] ); $seen{$_}++ foreach (@{$nonintersection_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); %pred = ( abel => 2, baker => 2, camera => 2, delta => 3, edward => 2, fargo => 2, golfer => 2, hilton => 1, ); @unpred = qw| icon jerky |; @bag = get_bag( '-u', [ \@a0, \@a1 ] ); $seen{$_}++ foreach (@bag); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $bag_ref = get_bag_ref( '-u', [ \@a0, \@a1 ] ); $seen{$_}++ foreach (@{$bag_ref}); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); # Tests for --unsorted option %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton ); @unpred = qw| icon jerky |; @union = get_union( '--unsorted', [ \@a0, \@a1 ] ); $seen{$_}++ foreach (@union); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel ); @unpred = qw| baker camera delta edward fargo golfer hilton icon jerky |; @unique = get_unique( '--unsorted', [ \@a0, \@a1 ] ); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); List-Compare-0.53/t/15_oo_lists_alt_mult_acc_sorted.t0000755000175000017500000004257712465263760022464 0ustar jkeenanjkeenan# perl #$Id$ # t/15_oo_lists_alt_mult_acc_sorted.t use strict; use Test::More tests => 106; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :arrays :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; ### new ### my $lcm = List::Compare->new( { accelerated => 1, lists => [ \@a0, \@a1, \@a2, \@a3, \@a4 ], } ); ok($lcm, "List::Compare constructor returned true value"); @pred = qw(abel baker camera delta edward fargo golfer hilton icon jerky); @union = $lcm->get_union; is_deeply( \@union, \@pred, "Got expected union"); $union_ref = $lcm->get_union_ref; is_deeply( $union_ref, \@pred, "Got expected union"); @pred = qw(baker camera delta edward fargo golfer hilton icon); @shared = $lcm->get_shared; is_deeply( \@shared, \@pred, "Got expected shared"); $shared_ref = $lcm->get_shared_ref; is_deeply( $shared_ref, \@pred, "Got expected shared"); @pred = qw(fargo golfer); @intersection = $lcm->get_intersection; is_deeply(\@intersection, \@pred, "Got expected intersection"); $intersection_ref = $lcm->get_intersection_ref; is_deeply($intersection_ref, \@pred, "Got expected intersection"); @pred = qw( jerky ); @unique = $lcm->get_unique(2); is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lcm->get_unique_ref(2); is_deeply($unique_ref, \@pred, "Got expected unique"); eval { $unique_ref = $lcm->get_unique_ref('jerky') }; like($@, qr/Argument to method List::Compare::Multiple::Accelerated::get_unique_ref must be the array index/, "Got expected error message" ); { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Lonly(2); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Lonly_ref(2); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Aonly(2); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Aonly_ref(2); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } @pred = qw( abel ); @unique = $lcm->get_unique; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lcm->get_unique_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Lonly(); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Lonly_ref(); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Aonly(); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Aonly_ref(); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } @pred = ( [ 'abel' ], [ ], [ 'jerky' ], [ ], [ ], ); $unique_all_ref = $lcm->get_unique_all(); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_unique_all()"); @pred = qw( abel icon jerky ); @complement = $lcm->get_complement(1); is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lcm->get_complement_ref(1); is_deeply($complement_ref, \@pred, "Got expected complement"); eval { $complement_ref = $lcm->get_complement_ref('jerky') }; like($@, qr/Argument to method List::Compare::Multiple::Accelerated::get_complement_ref must be the array index/, "Got expected error message" ); { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Ronly(1); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Ronly_ref(1); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Bonly(1); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Bonly_ref(1); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } @pred = qw ( hilton icon jerky ); @complement = $lcm->get_complement; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lcm->get_complement_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Ronly(); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Ronly_ref(); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Bonly(); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Bonly_ref(); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } @pred = qw( abel jerky ); @symmetric_difference = $lcm->get_symmetric_difference; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lcm->get_symmetric_difference_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lcm->get_symdiff; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lcm->get_symdiff_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); { my ($rv, $stdout, $stderr); capture( sub { @symmetric_difference = $lcm->get_LorRonly; }, \$stdout, \$stderr, ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcm->get_LorRonly_ref; }, \$stdout, \$stderr, ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @symmetric_difference = $lcm->get_AorBonly; }, \$stdout, \$stderr, ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcm->get_AorBonly_ref; }, \$stdout, \$stderr, ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly_ref or its alias defaults/, "Got expected warning", ); } %seen = (); @pred = ( [ qw( hilton icon jerky ) ], [ qw( abel icon jerky ) ], [ qw( abel baker camera delta edward ) ], [ qw( abel baker camera delta edward jerky ) ], [ qw( abel baker camera delta edward jerky ) ], ); $complement_all_ref = $lcm->get_complement_all(); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); @pred = qw( abel baker camera delta edward hilton icon jerky ); @nonintersection = $lcm->get_nonintersection; is_deeply( \@nonintersection, \@pred, "Got expected nonintersection"); $nonintersection_ref = $lcm->get_nonintersection_ref; is_deeply($nonintersection_ref, \@pred, "Got expected nonintersection"); @pred = qw( abel abel baker baker camera camera delta delta delta edward edward fargo fargo fargo fargo fargo fargo golfer golfer golfer golfer golfer hilton hilton hilton hilton icon icon icon icon icon jerky ); @bag = $lcm->get_bag; is_deeply(\@bag, \@pred, "Got expected bag"); $bag_ref = $lcm->get_bag_ref; is_deeply($bag_ref, \@pred, "Got expected bag"); $LR = $lcm->is_LsubsetR(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcm->is_AsubsetB(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcm->is_LsubsetR(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcm->is_AsubsetB(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcm->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); eval { $LR = $lcm->is_LsubsetR(2) }; like($@, qr/Method.*?requires 2 arguments/, "Got expected error message" ); eval { $LR = $lcm->is_LsubsetR(8,9) }; like($@, qr/Each argument to method.*?must be a valid array index /, "Got expected error message" ); { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcm->is_RsubsetL; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcm->is_BsubsetA; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } $eqv = $lcm->is_LequivalentR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcm->is_LeqvlntR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcm->is_LequivalentR(2,4); ok(! $eqv, "Got expected equivalence relationship"); eval { $eqv = $lcm->is_LequivalentR(2) }; like($@, qr/Method List::Compare::Multiple::Accelerated::is_LequivalentR requires 2 arguments/, "Got expected error message", ); eval { $eqv = $lcm->is_LequivalentR(8,9) }; like($@, qr/Each argument to method List::Compare::Multiple::Accelerated::is_LequivalentR must be a valid array index/, "Got expected error message", ); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcm->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcm->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); is_deeply( all_is_member_which( $lcm, \@args), $test_member_which_mult, "is_member_which() returned all expected values"); eval { $memb_arr_ref = $lcm->is_member_which('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which() correctly generated error message"); is_deeply( all_is_member_which_ref( $lcm, \@args), $test_member_which_mult, "is_member_which_ref() returned all expected values"); eval { $memb_arr_ref = $lcm->is_member_which_ref('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which_ref() correctly generated error message"); $memb_hash_ref = $lcm->are_members_which( \@args ); is_deeply($memb_hash_ref, $test_members_which_mult, "are_members_which() returned all expected values"); eval { $memb_hash_ref = $lcm->are_members_which( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_which() correctly generated error message"); is_deeply( all_is_member_any( $lcm, \@args), $test_member_any_mult, "is_member_which() returned all expected values"); eval { $lcm->is_member_any('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_any() correctly generated error message"); $memb_hash_ref = $lcm->are_members_any( \@args ); ok(wrap_are_members_any( $memb_hash_ref, $test_members_any_mult, ), "are_members_any() returned all expected values"); eval { $memb_hash_ref = $lcm->are_members_any( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_any() correctly generated error message"); $vers = $lcm->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lcm_dj = List::Compare->new( { accelerated => 1, lists => [ \@a0, \@a1, \@a2, \@a3, \@a4, \@a8 ], } ); ok($lcm_dj, "Constructor returned true value"); $disj = $lcm_dj->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); $disj = $lcm_dj->is_LdisjointR(2,3); ok(! $disj, "Got expected disjoint relationship"); $disj = $lcm_dj->is_LdisjointR(4,5); ok($disj, "Got expected disjoint relationship"); eval { $disj = $lcm_dj->is_LdisjointR(2) }; like($@, qr/Method List::Compare::Multiple::Accelerated::is_LdisjointR requires 2 arguments/, "Got expected error message"); ########## BELOW: Testfor bad arguments to constructor ########## my ($lcm_bad); my %h5 = ( golfer => 1, lambda => 0, ); eval { $lcm_bad = List::Compare->new( { accelerated => 1, lists => [ \@a0, \@a1, \@a2, \@a3, \%h5 ], } ); }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); eval { $lcm_bad = List::Compare->new( { accelerated => 1, lists => [ \%h5, \@a0, \@a1, \@a2, \@a3 ], } ); }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); my $scalar = 'test'; eval { $lcm_bad = List::Compare->new( { accelerated => 1, lists => [ \$scalar, \@a0, \@a1 ], } ); }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); List-Compare-0.53/t/43_func_hashes_mult_sorted.t0000755000175000017500000001664512465263760021447 0ustar jkeenanjkeenan# perl #$Id$ # 43_func_hashes_mult_sorted.t use strict; use Test::More tests => 43; use List::Compare::Functional qw(:originals :aliases); use lib ("./t"); use Test::ListCompareSpecial qw( :seen :func_wrap :hashes :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref); my @args; @pred = qw(abel baker camera delta edward fargo golfer hilton icon jerky); @union = get_union( [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); is_deeply( \@union, \@pred, "Got expected union"); $union_ref = get_union_ref( [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); is_deeply( $union_ref, \@pred, "Got expected union"); @pred = qw(baker camera delta edward fargo golfer hilton icon); @shared = get_shared( [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); is_deeply( \@shared, \@pred, "Got expected shared"); $shared_ref = get_shared_ref( [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); is_deeply( $shared_ref, \@pred, "Got expected shared"); @pred = qw(fargo golfer); @intersection = get_intersection( [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); is_deeply(\@intersection, \@pred, "Got expected intersection"); $intersection_ref = get_intersection_ref( [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); is_deeply($intersection_ref, \@pred, "Got expected intersection"); @pred = qw( jerky ); @unique = get_unique( [ \%h0, \%h1, \%h2, \%h3, \%h4 ], [ 2 ] ); is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = get_unique_ref( [ \%h0, \%h1, \%h2, \%h3, \%h4 ], [ 2 ] ); is_deeply($unique_ref, \@pred, "Got expected unique"); @pred = qw( abel ); @unique = get_unique( [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = get_unique_ref( [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); is_deeply($unique_ref, \@pred, "Got expected unique"); @pred = ( [ 'abel' ], [ ], [ 'jerky' ], [ ], [ ], ); $unique_all_ref = get_unique_all( [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); is_deeply($unique_all_ref, [ @pred ], "Got expected values for get_unique_all()"); @pred = qw( abel icon jerky ); @complement = get_complement([ \%h0, \%h1, \%h2, \%h3, \%h4 ], [ 1 ] ); is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = get_complement_ref([ \%h0, \%h1, \%h2, \%h3, \%h4 ], [ 1 ] ); is_deeply($complement_ref, \@pred, "Got expected complement"); @pred = qw ( hilton icon jerky ); @complement = get_complement( [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = get_complement_ref( [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); is_deeply($complement_ref, \@pred, "Got expected complement"); @pred = ( [ qw( hilton icon jerky ) ], [ qw( abel icon jerky ) ], [ qw( abel baker camera delta edward ) ], [ qw( abel baker camera delta edward jerky ) ], [ qw( abel baker camera delta edward jerky ) ], ); $complement_all_ref = get_complement_all( [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); is_deeply($complement_all_ref, [ @pred ], "Got expected values for get_complement_all()"); @pred = qw( abel jerky ); @symmetric_difference = get_symmetric_difference( [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = get_symmetric_difference_ref( [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = get_symdiff( [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = get_symdiff_ref( [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @pred = qw( abel baker camera delta edward hilton icon jerky ); @nonintersection = get_nonintersection( [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); is_deeply( \@nonintersection, \@pred, "Got expected nonintersection"); $nonintersection_ref = get_nonintersection_ref( [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); is_deeply($nonintersection_ref, \@pred, "Got expected nonintersection"); @pred = qw( abel abel baker baker camera camera delta delta delta edward edward fargo fargo fargo fargo fargo fargo golfer golfer golfer golfer golfer hilton hilton hilton hilton icon icon icon icon icon jerky ); @bag = get_bag( [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); is_deeply(\@bag, \@pred, "Got expected bag"); $bag_ref = get_bag_ref( [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); is_deeply($bag_ref, \@pred, "Got expected bag"); $LR = is_LsubsetR( [ \%h0, \%h1, \%h2, \%h3, \%h4 ], [ 3,2 ] ); ok($LR, "Got expected subset relationship"); $LR = is_LsubsetR( [ \%h0, \%h1, \%h2, \%h3, \%h4 ], [ 2,3 ] ); ok(! $LR, "Got expected subset relationship"); $LR = is_LsubsetR( [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); ok(! $LR, "Got expected subset relationship"); $eqv = is_LequivalentR( [ \%h0, \%h1, \%h2, \%h3, \%h4 ], [ 3,4 ] ); ok($eqv, "Got expected equivalence relationship"); $eqv = is_LeqvlntR( [ \%h0, \%h1, \%h2, \%h3, \%h4 ], [ 3,4 ] ); ok($eqv, "Got expected equivalence relationship"); $eqv = is_LequivalentR( [ \%h0, \%h1, \%h2, \%h3, \%h4 ], [ 2,4 ] ); ok(! $eqv, "Got expected equivalence relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = print_subset_chart( [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = print_equivalence_chart( [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); is_deeply(func_all_is_member_which( [ \%h0, \%h1, \%h2, \%h3, \%h4 ], \@args ), $test_member_which_mult, "is_member_which() returned all expected values"); is_deeply(func_all_is_member_which_ref( [ \%h0, \%h1, \%h2, \%h3, \%h4 ], \@args ), $test_member_which_mult, "is_member_which_ref() returned all expected values"); $memb_hash_ref = are_members_which( [ \%h0, \%h1, \%h2, \%h3, \%h4 ], \@args ); is_deeply($memb_hash_ref, $test_members_which_mult, "are_members_which() returned all expected values"); is_deeply(func_all_is_member_any( [ \%h0, \%h1, \%h2, \%h3, \%h4 ], \@args ), $test_member_any_mult, "is_member_any() returned all expected values"); $memb_hash_ref = are_members_any( [ \%h0, \%h1, \%h2, \%h3, \%h4 ], \@args ); ok(func_wrap_are_members_any( $memb_hash_ref, $test_members_any_mult, ), "are_members_any() returned all expected values"); $vers = get_version; ok($vers, "get_version() returned true value"); $disj = is_LdisjointR( [ \%h0, \%h1, \%h2, \%h3, \%h4, \%h8 ] ); ok(! $disj, "Got expected disjoint relationship"); $disj = is_LdisjointR( [ \%h0, \%h1, \%h2, \%h3, \%h4, \%h8 ], [ 2,3 ] ); ok(! $disj, "Got expected disjoint relationship"); $disj = is_LdisjointR( [ \%h0, \%h1, \%h2, \%h3, \%h4, \%h8 ], [ 4,5 ] ); ok($disj, "Got expected disjoint relationship"); List-Compare-0.53/t/48_func_hashes_alt_mult_unsorted.t0000755000175000017500000002164312465263760022651 0ustar jkeenanjkeenan# perl #$Id$ # 48_func_hashes_alt_mult_unsorted.t use strict; use Test::More tests => 42; use List::Compare::Functional qw(:originals :aliases); use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :hashes :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton icon jerky ); @unpred = qw| kappa |; @union = get_union( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], unsorted => 1, } ); $seen{$_}++ foreach (@union); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); $union_ref = get_union_ref( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], unsorted => 1, } ); $seen{$_}++ foreach (@{$union_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer hilton icon ); @unpred = qw| abel jerky |; @shared = get_shared( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], unsorted => 1, } ); $seen{$_}++ foreach (@shared); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); $shared_ref = get_shared_ref( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], unsorted => 1, } ); $seen{$_}++ foreach (@{$shared_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( fargo golfer ); @unpred = qw| abel baker camera delta edward hilton icon jerky |; @intersection = get_intersection( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], unsorted => 1, } ); $seen{$_}++ foreach (@intersection); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); $intersection_ref = get_intersection_ref( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], unsorted => 1, } ); $seen{$_}++ foreach (@{$intersection_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( jerky ); @unpred = qw| abel baker camera delta edward fargo golfer hilton icon |; @unique = get_unique( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], unsorted => 1, item => 2, } ); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = get_unique_ref( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], unsorted => 1, item => 2, } ); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ 'abel' ], [ ], [ 'jerky' ], [ ], [ ], ); $unique_all_ref = get_unique_all( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], unsorted => 1, } ); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %pred = map {$_, 1} qw( abel icon jerky ); @unpred = qw| baker camera delta edward fargo golfer hilton |; @complement = get_complement( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], unsorted => 1, item => 1, } ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = get_complement_ref( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], unsorted => 1, item => 1, } ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( hilton icon jerky ); @unpred = qw| abel baker camera delta edward fargo golfer |; @complement = get_complement( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], unsorted => 1, } ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = get_complement_ref( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], unsorted => 1, } ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel jerky ); @unpred = qw| baker camera delta edward fargo golfer hilton icon |; @symmetric_difference = get_symmetric_difference( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], unsorted => 1, } ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = get_symmetric_difference_ref( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], unsorted => 1, } ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = get_symdiff( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], unsorted => 1, } ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = get_symdiff_ref( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], unsorted => 1, } ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ qw( hilton icon jerky ) ], [ qw( abel icon jerky ) ], [ qw( abel baker camera delta edward ) ], [ qw( abel baker camera delta edward jerky ) ], [ qw( abel baker camera delta edward jerky ) ], ); $complement_all_ref = get_complement_all( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], unsorted => 1, } ); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %seen = (); %pred = map {$_, 1} qw( abel baker camera delta edward hilton icon jerky ); @unpred = qw| fargo golfer |; @nonintersection = get_nonintersection( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], unsorted => 1, } ); $seen{$_}++ foreach (@nonintersection); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); $nonintersection_ref = get_nonintersection_ref( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], unsorted => 1, } ); $seen{$_}++ foreach (@{$nonintersection_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); %pred = ( abel => 2, baker => 2, camera => 2, delta => 3, edward => 2, fargo => 6, golfer => 5, hilton => 4, icon => 5, jerky => 1, ); @unpred = qw| kappa |; @bag = get_bag( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], unsorted => 1, } ); $seen{$_}++ foreach (@bag); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $bag_ref = get_bag_ref( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], unsorted => 1, } ); $seen{$_}++ foreach (@{$bag_ref}); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); List-Compare-0.53/t/07_oo_lists_mult_acc_sorted.t0000755000175000017500000004546412465263760021623 0ustar jkeenanjkeenan# perl #$Id$ # 07_oo_lists_mult_acc_sorted.t use strict; use Test::More tests => 114; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :arrays :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; ### new ### my $lcm = List::Compare->new('-a', \@a0, \@a1, \@a2, \@a3, \@a4); ok($lcm, "List::Compare constructor returned true value"); @pred = qw(abel baker camera delta edward fargo golfer hilton icon jerky); @union = $lcm->get_union; is_deeply( \@union, \@pred, "Got expected union"); $union_ref = $lcm->get_union_ref; is_deeply( $union_ref, \@pred, "Got expected union"); @pred = qw(baker camera delta edward fargo golfer hilton icon); @shared = $lcm->get_shared; is_deeply( \@shared, \@pred, "Got expected shared"); $shared_ref = $lcm->get_shared_ref; is_deeply( $shared_ref, \@pred, "Got expected shared"); @pred = qw(fargo golfer); @intersection = $lcm->get_intersection; is_deeply(\@intersection, \@pred, "Got expected intersection"); $intersection_ref = $lcm->get_intersection_ref; is_deeply($intersection_ref, \@pred, "Got expected intersection"); @pred = qw( jerky ); @unique = $lcm->get_unique(2); is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lcm->get_unique_ref(2); is_deeply($unique_ref, \@pred, "Got expected unique"); eval { $unique_ref = $lcm->get_unique_ref('jerky') }; like($@, qr/Argument to method List::Compare::Multiple::Accelerated::get_unique_ref must be the array index/, "Got expected error message" ); eval { $unique_ref = $lcm->get_unique_ref(999) }; like($@, qr/Argument to method List::Compare::Multiple::Accelerated::get_unique_ref must be the array index/, "Got expected error message" ); { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Lonly(2); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Lonly_ref(2); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Aonly(2); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Aonly_ref(2); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } @pred = qw( abel ); @unique = $lcm->get_unique; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lcm->get_unique_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Lonly(); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Lonly_ref(); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Aonly(); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Aonly_ref(); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } @pred = ( [ 'abel' ], [ ], [ 'jerky' ], [ ], [ ], ); $unique_all_ref = $lcm->get_unique_all(); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_unique_all()"); @pred = qw( abel icon jerky ); @complement = $lcm->get_complement(1); is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lcm->get_complement_ref(1); is_deeply($complement_ref, \@pred, "Got expected complement"); eval { $complement_ref = $lcm->get_complement_ref('jerky') }; like($@, qr/Argument to method List::Compare::Multiple::Accelerated::get_complement_ref must be the array index/, "Got expected error message" ); eval { $complement_ref = $lcm->get_complement_ref(999) }; like($@, qr/Argument to method List::Compare::Multiple::Accelerated::get_complement_ref must be the array index/, "Got expected error message" ); { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Ronly(1); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Ronly_ref(1); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Bonly(1); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Bonly_ref(1); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } @pred = qw ( hilton icon jerky ); @complement = $lcm->get_complement; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lcm->get_complement_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Ronly(); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Ronly_ref(); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Bonly(); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Bonly_ref(); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } @pred = qw( abel jerky ); @symmetric_difference = $lcm->get_symmetric_difference; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lcm->get_symmetric_difference_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lcm->get_symdiff; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lcm->get_symdiff_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); { my ($rv, $stdout, $stderr); capture( sub { @symmetric_difference = $lcm->get_LorRonly; }, \$stdout, \$stderr, ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcm->get_LorRonly_ref; }, \$stdout, \$stderr, ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @symmetric_difference = $lcm->get_AorBonly; }, \$stdout, \$stderr, ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcm->get_AorBonly_ref; }, \$stdout, \$stderr, ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly_ref or its alias defaults/, "Got expected warning", ); } %seen = (); @pred = ( [ qw( hilton icon jerky ) ], [ qw( abel icon jerky ) ], [ qw( abel baker camera delta edward ) ], [ qw( abel baker camera delta edward jerky ) ], [ qw( abel baker camera delta edward jerky ) ], ); $complement_all_ref = $lcm->get_complement_all(); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); @pred = qw( abel baker camera delta edward hilton icon jerky ); @nonintersection = $lcm->get_nonintersection; is_deeply( \@nonintersection, \@pred, "Got expected nonintersection"); $nonintersection_ref = $lcm->get_nonintersection_ref; is_deeply($nonintersection_ref, \@pred, "Got expected nonintersection"); @pred = qw( abel abel baker baker camera camera delta delta delta edward edward fargo fargo fargo fargo fargo fargo golfer golfer golfer golfer golfer hilton hilton hilton hilton icon icon icon icon icon jerky ); @bag = $lcm->get_bag; is_deeply(\@bag, \@pred, "Got expected bag"); $bag_ref = $lcm->get_bag_ref; is_deeply($bag_ref, \@pred, "Got expected bag"); $LR = $lcm->is_LsubsetR(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcm->is_AsubsetB(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcm->is_LsubsetR(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcm->is_AsubsetB(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcm->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); eval { $LR = $lcm->is_LsubsetR(2) }; like($@, qr/Method.*?requires 2 arguments/, "Got expected error message" ); eval { $LR = $lcm->is_LsubsetR(8,9) }; like($@, qr/Each argument to method.*?must be a valid array index /, "Got expected error message" ); { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcm->is_RsubsetL; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcm->is_BsubsetA; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } $eqv = $lcm->is_LequivalentR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcm->is_LeqvlntR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcm->is_LequivalentR(2,4); ok(! $eqv, "Got expected equivalence relationship"); eval { $eqv = $lcm->is_LequivalentR(2) }; like($@, qr/Method List::Compare::Multiple::Accelerated::is_LequivalentR requires 2 arguments/, "Got expected error message", ); eval { $eqv = $lcm->is_LequivalentR(8,9) }; like($@, qr/Each argument to method List::Compare::Multiple::Accelerated::is_LequivalentR must be a valid array index/, "Got expected error message", ); eval { $eqv = $lcm->is_LequivalentR('jerky',9) }; like($@, qr/Each argument to method List::Compare::Multiple::Accelerated::is_LequivalentR must be a valid array index/, "Got expected error message", ); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcm->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcm->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); is_deeply( all_is_member_which( $lcm, \@args), $test_member_which_mult, "is_member_which() returned all expected values"); eval { $memb_arr_ref = $lcm->is_member_which('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which() correctly generated error message"); is_deeply( all_is_member_which_ref( $lcm, \@args), $test_member_which_mult, "is_member_which_ref() returned all expected values"); eval { $memb_arr_ref = $lcm->is_member_which_ref('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which_ref() correctly generated error message"); eval { $memb_arr_ref = $lcm->is_member_which_ref( [ 'jerky' ] ) }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which_ref() correctly generated error message"); $memb_hash_ref = $lcm->are_members_which( \@args ); is_deeply($memb_hash_ref, $test_members_which_mult, "are_members_which() returned all expected values"); eval { $memb_hash_ref = $lcm->are_members_which( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_which() correctly generated error message"); eval { $memb_hash_ref = $lcm->are_members_which( \@args, [ 1 .. 3 ] ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_which() correctly generated error message"); is_deeply( all_is_member_any( $lcm, \@args), $test_member_any_mult, "is_member_which() returned all expected values"); eval { $lcm->is_member_any('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_any() correctly generated error message"); eval { $lcm->is_member_any( [ 'jerky' ] ) }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_any() correctly generated error message"); $memb_hash_ref = $lcm->are_members_any( \@args ); ok(wrap_are_members_any( $memb_hash_ref, $test_members_any_mult, ), "are_members_any() returned all expected values"); eval { $memb_hash_ref = $lcm->are_members_any( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_any() correctly generated error message"); eval { $memb_hash_ref = $lcm->are_members_any( \@args, [ 1..3 ] ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_any() correctly generated error message"); $vers = $lcm->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lcm_dj = List::Compare->new('-a', \@a0, \@a1, \@a2, \@a3, \@a4, \@a8); ok($lcm_dj, "Constructor returned true value"); $disj = $lcm_dj->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); $disj = $lcm_dj->is_LdisjointR(2,3); ok(! $disj, "Got expected disjoint relationship"); $disj = $lcm_dj->is_LdisjointR(4,5); ok($disj, "Got expected disjoint relationship"); eval { $disj = $lcm_dj->is_LdisjointR(2) }; like($@, qr/Method List::Compare::Multiple::Accelerated::is_LdisjointR requires 2 arguments/, "Got expected error message"); eval { $eqv = $lcm->is_LdisjointR('jerky',5) }; like($@, qr/Each argument to method List::Compare::Multiple::Accelerated::is_LdisjointR must be a valid array index/, "Got expected error message", ); ########## BELOW: Testfor bad arguments to constructor ########## my ($lcm_bad); my %h5 = ( golfer => 1, lambda => 0, ); eval { $lcm_bad = List::Compare->new('-a', \@a0, \@a1, \@a2, \@a3, \%h5) }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); eval { $lcm_bad = List::Compare->new('-a', \%h5, \@a0, \@a1, \@a2, \@a3) }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); my $scalar = 'test'; eval { $lcm_bad = List::Compare->new('-a', \$scalar, \@a0, \@a1) }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); List-Compare-0.53/t/28_oo_hashes_alt_dual_acc_unsorted.t0000755000175000017500000003514212465263760023102 0ustar jkeenanjkeenan# perl #$Id$ # 28_oo_hashes_alt_dual_acc_unsorted.t use strict; use Test::More tests => 100; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :hashes :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; my $test_members_which = { abel => [ 1, [ qw< 0 > ] ], baker => [ 2, [ qw< 0 1 > ] ], camera => [ 2, [ qw< 0 1 > ] ], delta => [ 2, [ qw< 0 1 > ] ], edward => [ 2, [ qw< 0 1 > ] ], fargo => [ 2, [ qw< 0 1 > ] ], golfer => [ 2, [ qw< 0 1 > ] ], hilton => [ 1, [ qw< 1 > ] ], icon => [ 0, [ qw< > ] ], jerky => [ 0, [ qw< > ] ], zebra => [ 0, [ qw< > ] ], }; my $test_members_any = { abel => 1, baker => 1, camera => 1, delta => 1, edward => 1, fargo => 1, golfer => 1, hilton => 1, icon => 0, jerky => 0, zebra => 0, }; ### new ### my $lcu = List::Compare->new( { unsorted => 1, accelerated => 1, lists => [ \%h0, \%h1 ], } ); ok($lcu, "constructor returned true value"); %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton ); @unpred = qw| icon jerky |; @union = $lcu->get_union; $seen{$_}++ foreach (@union); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); $union_ref = $lcu->get_union_ref; $seen{$_}++ foreach (@{$union_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton ); { my ($rv, $stdout, $stderr); capture( sub { @shared = $lcu->get_shared; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@shared); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); { my ($rv, $stdout, $stderr); capture( sub { $shared_ref = $lcu->get_shared_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$shared_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer ); @unpred = qw| abel hilton icon jerky |; @intersection = $lcu->get_intersection; $seen{$_}++ foreach (@intersection); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); $intersection_ref = $lcu->get_intersection_ref; $seen{$_}++ foreach (@{$intersection_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel ); @unpred = qw| baker camera delta edward fargo golfer hilton icon jerky |; @unique = $lcu->get_unique; $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcu->get_unique_ref; $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @unique = $lcu->get_Lonly; $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcu->get_Lonly_ref; $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @unique = $lcu->get_Aonly; $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcu->get_Aonly_ref; $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ 'abel' ], [ 'hilton' ], ); $unique_all_ref = $lcu->get_unique_all(); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_unique_all()"); %pred = map {$_, 1} qw( hilton ); @unpred = qw| abel baker camera delta edward fargo golfer icon jerky |; @complement = $lcu->get_complement; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcu->get_complement_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @complement = $lcu->get_Ronly; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcu->get_Ronly_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @complement = $lcu->get_Bonly; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcu->get_Bonly_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ qw( hilton ) ], [ qw( abel ) ], ); $complement_all_ref = $lcu->get_complement_all(); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %pred = map {$_, 1} qw( abel hilton ); @unpred = qw| baker camera delta edward fargo golfer icon jerky |; @symmetric_difference = $lcu->get_symmetric_difference; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_symmetric_difference_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcu->get_symdiff; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_symdiff_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcu->get_LorRonly; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_LorRonly_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcu->get_AorBonly; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_AorBonly_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel hilton ); @unpred = qw| baker camera delta edward fargo golfer icon jerky |; { my ($rv, $stdout, $stderr); capture( sub { @nonintersection = $lcu->get_nonintersection; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@nonintersection); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); { my ($rv, $stdout, $stderr); capture( sub { $nonintersection_ref = $lcu->get_nonintersection_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$nonintersection_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); %pred = ( abel => 2, baker => 2, camera => 2, delta => 3, edward => 2, fargo => 2, golfer => 2, hilton => 1, ); @unpred = qw| icon jerky |; @bag = $lcu->get_bag; $seen{$_}++ foreach (@bag); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $bag_ref = $lcu->get_bag_ref; $seen{$_}++ foreach (@{$bag_ref}); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $LR = $lcu->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); $LR = $lcu->is_AsubsetB; ok(! $LR, "Got expected subset relationship"); $RL = $lcu->is_RsubsetL; ok(! $RL, "Got expected subset relationship"); $RL = $lcu->is_BsubsetA; ok(! $RL, "Got expected subset relationship"); $eqv = $lcu->is_LequivalentR; ok(! $eqv, "Got expected equivalent relationship"); $eqv = $lcu->is_LeqvlntR; ok(! $eqv, "Got expected equivalent relationship"); $disj = $lcu->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcu->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcu->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } ok(wrap_is_member_which( $lcu, $test_members_which, ), "is_member_which() returned all expected values"); ok(wrap_is_member_which_ref( $lcu, $test_members_which, ), "is_member_which_ref() returned all expected values"); $memb_hash_ref = $lcu->are_members_which( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); ok(wrap_are_members_which( $memb_hash_ref, $test_members_which, ), "are_members_which() returned all expected value"); ok(wrap_is_member_any( $lcu, $test_members_any, ), "is_member_any() returned all expected values"); $memb_hash_ref = $lcu->are_members_any( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); ok(wrap_are_members_any( $memb_hash_ref, $test_members_any, ), "are_members_any() returned all expected values"); $vers = $lcu->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lcu_s = List::Compare->new( { unsorted => 1, accelerated => 1, lists => [ \%h2, \%h3 ], } ); ok($lcu_s, "constructor returned true value"); $LR = $lcu_s->is_LsubsetR; ok(! $LR, "non-subset correctly determined"); $LR = $lcu_s->is_AsubsetB; ok(! $LR, "non-subset correctly determined"); $RL = $lcu_s->is_RsubsetL; ok($RL, "subset correctly determined"); $RL = $lcu_s->is_BsubsetA; ok($RL, "subset correctly determined"); $eqv = $lcu_s->is_LequivalentR; ok(! $eqv, "non-equivalence correctly determined"); $eqv = $lcu_s->is_LeqvlntR; ok(! $eqv, "non-equivalence correctly determined"); $disj = $lcu_s->is_LdisjointR; ok(! $disj, "non-disjoint correctly determined"); ### new ### my $lcu_e = List::Compare->new( { unsorted => 1, accelerated => 1, lists => [ \%h3, \%h4 ], } ); ok($lcu_e, "constructor returned true value"); $eqv = $lcu_e->is_LequivalentR; ok($eqv, "Got expected equivalent relationship"); $eqv = $lcu_e->is_LeqvlntR; ok($eqv, "Got expected equivalent relationship"); $disj = $lcu_e->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); ### new ### my $lcu_dj = List::Compare->new( { unsorted => 1, accelerated => 1, lists => [ \%h4, \%h8 ], } ); ok($lcu_dj, "constructor returned true value"); ok(0 == $lcu_dj->get_intersection, "no intersection, as expected"); ok(0 == scalar(@{$lcu_dj->get_intersection_ref}), "no intersection, as expected"); $disj = $lcu_dj->is_LdisjointR; ok($disj, "disjoint correctly determined"); List-Compare-0.53/t/33_func_lists_dual_sorted.t0000755000175000017500000001635312465263760021271 0ustar jkeenanjkeenan# perl #$Id$ # 33_func_lists_dual_sorted.t use strict; use Test::More qw(no_plan); # tests => 50; use List::Compare::Functional qw(:originals :aliases); use lib ("./t"); use Test::ListCompareSpecial qw( :seen :func_wrap :arrays :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref); my @args; @pred = qw(abel baker camera delta edward fargo golfer hilton); @union = get_union( [ \@a0, \@a1 ] ); is_deeply( \@union, \@pred, "Got expected union"); $union_ref = get_union_ref( [ \@a0, \@a1 ] ); is_deeply( $union_ref, \@pred, "Got expected union"); @pred = qw( baker camera delta edward fargo golfer ); @shared = get_shared( [ \@a0, \@a1 ] ); is_deeply( \@shared, \@pred, "Got expected shared"); $shared_ref = get_shared_ref( [ \@a0, \@a1 ] ); is_deeply( $shared_ref, \@pred, "Got expected shared"); @pred = qw( baker camera delta edward fargo golfer ); @intersection = get_intersection( [ \@a0, \@a1 ] ); is_deeply(\@intersection, \@pred, "Got expected intersection"); $intersection_ref = get_intersection_ref( [ \@a0, \@a1 ] ); is_deeply($intersection_ref, \@pred, "Got expected intersection"); @pred = qw( abel ); @unique = get_unique( [ \@a0, \@a1 ] ); is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = get_unique_ref( [ \@a0, \@a1 ] ); is_deeply($unique_ref, \@pred, "Got expected unique"); @pred = ( [ 'abel' ], [ 'hilton' ], ); $unique_all_ref = get_unique_all( [ \@a0, \@a1 ] ); is_deeply($unique_all_ref, [ @pred ], "Got expected values for get_unique_all()"); eval { $unique_all_ref = get_unique_all( [ \@a0, \@a1 ], [ 'foobar' ] ); }; like($@, qr/Subroutine call requires exactly 1 reference as argument/, "Got expected error message for too many arguments"); @pred = qw ( hilton ); @complement = get_complement( [ \@a0, \@a1 ] ); is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = get_complement_ref( [ \@a0, \@a1 ] ); is_deeply($complement_ref, \@pred, "Got expected complement"); @pred = ( [ qw( hilton ) ], [ qw( abel ) ], ); $complement_all_ref = get_complement_all( [ \@a0, \@a1 ] ); is_deeply($complement_all_ref, [ @pred ], "Got expected values for get_complement_all()"); eval { $complement_all_ref = get_complement_all( [ \@a0, \@a1 ], [ 'foobar' ] ); }; like($@, qr/Subroutine call requires exactly 1 reference as argument/, "Got expected error message for too many arguments"); @pred = qw( abel hilton ); @symmetric_difference = get_symmetric_difference( [ \@a0, \@a1 ] ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = get_symmetric_difference_ref( [ \@a0, \@a1 ] ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = get_symdiff( [ \@a0, \@a1 ] ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = get_symdiff_ref( [ \@a0, \@a1 ] ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @pred = qw( abel hilton ); @nonintersection = get_nonintersection( [ \@a0, \@a1 ] ); is_deeply(\@nonintersection, \@pred, "Got expected nonintersection"); $nonintersection_ref = get_nonintersection_ref( [ \@a0, \@a1 ] ); is_deeply($nonintersection_ref, \@pred, "Got expected nonintersection"); @pred = qw( abel abel baker baker camera camera delta delta delta edward edward fargo fargo golfer golfer hilton ); @bag = get_bag( [ \@a0, \@a1 ] ); is_deeply(\@bag, \@pred, "Got expected bag"); $bag_ref = get_bag_ref( [ \@a0, \@a1 ] ); is_deeply($bag_ref, \@pred, "Got expected bag"); $LR = is_LsubsetR( [ \@a0, \@a1 ] ); ok(! $LR, "Got expected subset relationship"); $RL = is_RsubsetL( [ \@a0, \@a1 ] ); ok(! $RL, "Got expected subset relationship"); $eqv = is_LequivalentR( [ \@a0, \@a1 ] ); ok(! $eqv, "Got expected equivalent relationship"); $eqv = is_LeqvlntR( [ \@a0, \@a1 ] ); ok(! $eqv, "Got expected equivalent relationship"); $disj = is_LdisjointR( [ \@a0, \@a1 ] ); ok(! $disj, "Got expected disjoint relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = print_subset_chart( [ \@a0, \@a1 ] ); }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } eval { my $rv = print_subset_chart( [ \@a0, \@a1 ], [ 'bogus' ] ); }; like($@, qr/Subroutine call requires exactly 1 reference as argument/, "Got expected error message for too many arguments"); { my ($rv, $stdout, $stderr); capture( sub { $rv = print_equivalence_chart( [ \@a0, \@a1 ] ); }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } eval { my $rv = print_equivalence_chart( [ \@a0, \@a1 ], [ 'bogus' ] ); }; like($@, qr/Subroutine call requires exactly 1 reference as argument/, "Got expected error message for too many arguments"); @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); is_deeply(func_all_is_member_which( [ \@a0, \@a1 ], \@args ), $test_member_which_dual, "is_member_which() returned all expected values"); is_deeply(func_all_is_member_which_ref( [ \@a0, \@a1 ], \@args ), $test_member_which_dual, "is_member_which() returned all expected values"); $memb_hash_ref = are_members_which( [ \@a0, \@a1 ] , \@args ); ok(func_wrap_are_members_which( $memb_hash_ref, $test_members_which, ), "are_members_which() returned all expected values"); is_deeply(func_all_is_member_any( [ \@a0, \@a1 ], \@args ), $test_member_any_dual, "is_member_any() returned all expected values"); $memb_hash_ref = are_members_any( [ \@a0, \@a1 ], \@args ); ok(func_wrap_are_members_any( $memb_hash_ref, $test_members_any, ), "are_members_any() returned all expected values"); $vers = get_version; ok($vers, "get_version() returned true value"); $LR = is_LsubsetR( [ \@a2, \@a3 ] ); ok(! $LR, "non-subset correctly determined"); $RL = is_RsubsetL( [ \@a2, \@a3 ] ); ok($RL, "subset correctly determined"); $eqv = is_LequivalentR( [ \@a2, \@a3 ] ); ok(! $eqv, "non-equivalence correctly determined"); $eqv = is_LeqvlntR( [ \@a2, \@a3 ] ); ok(! $eqv, "non-equivalence correctly determined"); $disj = is_LdisjointR( [ \@a2, \@a3 ] ); ok(! $disj, "non-disjoint correctly determined"); $eqv = is_LequivalentR( [ \@a3, \@a4 ] ); ok($eqv, "equivalence correctly determined"); $eqv = is_LeqvlntR( [ \@a3, \@a4 ] ); ok($eqv, "equivalence correctly determined"); $disj = is_LdisjointR( [ \@a3, \@a4 ] ); ok(! $disj, "non-disjoint correctly determined"); ok(0 == get_intersection( [ \@a4, \@a8 ] ), "no intersection, as expected"); ok(0 == scalar(@{get_intersection_ref( [ \@a4, \@a8 ] )}), "no intersection, as expected"); $disj = is_LdisjointR( [ \@a4, \@a8 ] ); ok($disj, "disjoint correctly determined"); List-Compare-0.53/t/06_oo_lists_mult_reg_unsorted.t0000755000175000017500000004333212465263760022204 0ustar jkeenanjkeenan# perl #$Id$ # 06_oo_lists_mult_reg_unsorted.t use strict; use Test::More tests => 110; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :arrays :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; ### new ### my $lcmu = List::Compare->new('-u', \@a0, \@a1, \@a2, \@a3, \@a4); ok($lcmu, "List::Compare constructor returned true value"); %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton icon jerky ); @unpred = qw| kappa |; @union = $lcmu->get_union; $seen{$_}++ foreach (@union); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); $union_ref = $lcmu->get_union_ref; $seen{$_}++ foreach (@{$union_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer hilton icon ); @unpred = qw| abel jerky |; @shared = $lcmu->get_shared; $seen{$_}++ foreach (@shared); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); $shared_ref = $lcmu->get_shared_ref; $seen{$_}++ foreach (@{$shared_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( fargo golfer ); @unpred = qw| abel baker camera delta edward hilton icon jerky |; @intersection = $lcmu->get_intersection; $seen{$_}++ foreach (@intersection); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); $intersection_ref = $lcmu->get_intersection_ref; $seen{$_}++ foreach (@{$intersection_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( jerky ); @unpred = qw| abel baker camera delta edward fargo golfer hilton icon |; @unique = $lcmu->get_unique(2); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcmu->get_unique_ref(2); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @unique = $lcmu->get_Lonly(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $unique_ref = $lcmu->get_Lonly_ref(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { @unique = $lcmu->get_Aonly(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $unique_ref = $lcmu->get_Aonly_ref(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); @pred = ( [ 'abel' ], [ ], [ 'jerky' ], [ ], [ ], ); $unique_all_ref = $lcmu->get_unique_all(); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %pred = map {$_, 1} qw( abel icon jerky ); @unpred = qw| baker camera delta edward fargo golfer hilton |; @complement = $lcmu->get_complement(1); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcmu->get_complement_ref(1); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @complement = $lcmu->get_Bonly(1); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $complement_ref = $lcmu->get_Bonly_ref(1); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); %pred = map {$_, 1} qw( hilton icon jerky ); @unpred = qw| abel baker camera delta edward fargo golfer |; @complement = $lcmu->get_complement; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcmu->get_complement_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @complement = $lcmu->get_Ronly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $complement_ref = $lcmu->get_Ronly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { @complement = $lcmu->get_Bonly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $complement_ref = $lcmu->get_Bonly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); %pred = map {$_, 1} qw( abel jerky ); @unpred = qw| baker camera delta edward fargo golfer hilton icon |; @symmetric_difference = $lcmu->get_symmetric_difference; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcmu->get_symmetric_difference_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcmu->get_symdiff; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcmu->get_symdiff_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @symmetric_difference = $lcmu->get_LorRonly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } %seen = (); { my ($stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcmu->get_LorRonly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); } %seen = (); { my ($stdout, $stderr); capture( sub { @symmetric_difference = $lcmu->get_AorBonly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } %seen = (); { my ($stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcmu->get_AorBonly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); } %seen = (); @pred = ( [ qw( hilton icon jerky ) ], [ qw( abel icon jerky ) ], [ qw( abel baker camera delta edward ) ], [ qw( abel baker camera delta edward jerky ) ], [ qw( abel baker camera delta edward jerky ) ], ); $complement_all_ref = $lcmu->get_complement_all(); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %seen = (); %pred = map {$_, 1} qw( abel baker camera delta edward hilton icon jerky ); @unpred = qw| fargo golfer |; @nonintersection = $lcmu->get_nonintersection; $seen{$_}++ foreach (@nonintersection); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); $nonintersection_ref = $lcmu->get_nonintersection_ref; $seen{$_}++ foreach (@{$nonintersection_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); %pred = ( abel => 2, baker => 2, camera => 2, delta => 3, edward => 2, fargo => 6, golfer => 5, hilton => 4, icon => 5, jerky => 1, ); @unpred = qw| kappa |; @bag = $lcmu->get_bag; $seen{$_}++ foreach (@bag); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $bag_ref = $lcmu->get_bag_ref; $seen{$_}++ foreach (@{$bag_ref}); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $LR = $lcmu->is_LsubsetR(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcmu->is_AsubsetB(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcmu->is_LsubsetR(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcmu->is_AsubsetB(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcmu->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcmu->is_RsubsetL; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcmu->is_BsubsetA; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } $eqv = $lcmu->is_LequivalentR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcmu->is_LeqvlntR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcmu->is_LequivalentR(2,4); ok(! $eqv, "Got expected equivalence relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcmu->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcmu->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); is_deeply( all_is_member_which( $lcmu, \@args), $test_member_which_mult, "is_member_which() returned all expected values"); is_deeply( all_is_member_which_ref( $lcmu, \@args), $test_member_which_mult, "is_member_which_ref() returned all expected values"); $memb_hash_ref = $lcmu->are_members_which( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); is_deeply($memb_hash_ref, $test_members_which_mult, "are_members_which() returned all expected values"); is_deeply( all_is_member_any( $lcmu, \@args), $test_member_any_mult, "is_member_which() returned all expected values"); $memb_hash_ref = $lcmu->are_members_any( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); is_deeply($memb_hash_ref, $test_members_any_mult, "are_members_any() returned all expected values"); $vers = $lcmu->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lcmu_dj = List::Compare->new(\@a0, \@a1, \@a2, \@a3, \@a4, \@a8); ok($lcmu_dj, "List::Compare constructor returned true value"); $disj = $lcmu_dj->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); $disj = $lcmu_dj->is_LdisjointR(2,3); ok(! $disj, "Got expected disjoint relationship"); $disj = $lcmu_dj->is_LdisjointR(4,5); ok($disj, "Got expected disjoint relationship"); ########## BELOW: Test for '--unsorted' option ########## my $lcmun = List::Compare->new('--unsorted', \@a0, \@a1, \@a2, \@a3, \@a4); ok($lcmu_dj, "List::Compare constructor returned true value"); List-Compare-0.53/t/21_oo_hashes_mult_reg_sorted.t0000755000175000017500000004115412465263760021753 0ustar jkeenanjkeenan# perl #$Id$ # 21_oo_hashes_mult_reg_sorted.t use strict; use Test::More tests => 104; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :hashes :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; ### new ### my $lcm = List::Compare->new(\%h0, \%h1, \%h2, \%h3, \%h4); ok($lcm, "List::Compare constructor returned true value"); @pred = qw(abel baker camera delta edward fargo golfer hilton icon jerky); @union = $lcm->get_union; is_deeply( \@union, \@pred, "Got expected union"); $union_ref = $lcm->get_union_ref; is_deeply( $union_ref, \@pred, "Got expected union"); @pred = qw(baker camera delta edward fargo golfer hilton icon); @shared = $lcm->get_shared; is_deeply( \@shared, \@pred, "Got expected shared"); $shared_ref = $lcm->get_shared_ref; is_deeply( $shared_ref, \@pred, "Got expected shared"); @pred = qw(fargo golfer); @intersection = $lcm->get_intersection; is_deeply(\@intersection, \@pred, "Got expected intersection"); $intersection_ref = $lcm->get_intersection_ref; is_deeply($intersection_ref, \@pred, "Got expected intersection"); @pred = qw( jerky ); @unique = $lcm->get_unique(2); is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lcm->get_unique_ref(2); is_deeply($unique_ref, \@pred, "Got expected unique"); eval { $unique_ref = $lcm->get_unique_ref('jerky') }; like($@, qr/Argument to method List::Compare::Multiple::get_unique_ref must be the array index/, "Got expected error message" ); { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Lonly(2); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Lonly_ref(2); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Aonly(2); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Aonly_ref(2); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } @pred = qw( abel ); @unique = $lcm->get_unique; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lcm->get_unique_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Lonly(); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Lonly_ref(); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Aonly(); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Aonly_ref(); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } @pred = ( [ 'abel' ], [ ], [ 'jerky' ], [ ], [ ], ); $unique_all_ref = $lcm->get_unique_all(); is_deeply($unique_all_ref, [ @pred ], "Got expected values for get_unique_all()"); @pred = qw( abel icon jerky ); @complement = $lcm->get_complement(1); is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lcm->get_complement_ref(1); is_deeply($complement_ref, \@pred, "Got expected complement"); eval { $complement_ref = $lcm->get_complement_ref('jerky') }; like($@, qr/Argument to method List::Compare::Multiple::get_complement_ref must be the array index/, "Got expected error message" ); { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Ronly(1); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Ronly_ref(1); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Bonly(1); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Bonly_ref(1); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } @pred = qw ( hilton icon jerky ); @complement = $lcm->get_complement; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lcm->get_complement_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Ronly(); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Ronly_ref(); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Bonly(); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Bonly_ref(); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } @pred = ( [ qw( hilton icon jerky ) ], [ qw( abel icon jerky ) ], [ qw( abel baker camera delta edward ) ], [ qw( abel baker camera delta edward jerky ) ], [ qw( abel baker camera delta edward jerky ) ], ); $complement_all_ref = $lcm->get_complement_all(); is_deeply($complement_all_ref, [ @pred ], "Got expected values for get_complement_all()"); @pred = qw( abel jerky ); @symmetric_difference = $lcm->get_symmetric_difference; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lcm->get_symmetric_difference_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lcm->get_symdiff; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lcm->get_symdiff_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); { my ($rv, $stdout, $stderr); capture( sub { @symmetric_difference = $lcm->get_LorRonly; }, \$stdout, \$stderr, ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcm->get_LorRonly_ref; }, \$stdout, \$stderr, ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @symmetric_difference = $lcm->get_AorBonly; }, \$stdout, \$stderr, ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcm->get_AorBonly_ref; }, \$stdout, \$stderr, ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly_ref or its alias defaults/, "Got expected warning", ); } @pred = qw( abel baker camera delta edward hilton icon jerky ); @nonintersection = $lcm->get_nonintersection; is_deeply( \@nonintersection, \@pred, "Got expected nonintersection"); $nonintersection_ref = $lcm->get_nonintersection_ref; is_deeply($nonintersection_ref, \@pred, "Got expected nonintersection"); @pred = qw( abel abel baker baker camera camera delta delta delta edward edward fargo fargo fargo fargo fargo fargo golfer golfer golfer golfer golfer hilton hilton hilton hilton icon icon icon icon icon jerky ); @bag = $lcm->get_bag; is_deeply(\@bag, \@pred, "Got expected bag"); $bag_ref = $lcm->get_bag_ref; is_deeply($bag_ref, \@pred, "Got expected bag"); $LR = $lcm->is_LsubsetR(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcm->is_AsubsetB(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcm->is_LsubsetR(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcm->is_AsubsetB(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcm->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); eval { $LR = $lcm->is_LsubsetR(2) }; like($@, qr/Method List::Compare::Multiple::is_LsubsetR requires 2 arguments/, "Got expected error message" ); eval { $LR = $lcm->is_LsubsetR(8,9) }; like($@, qr/Each argument to method List::Compare::Multiple::is_LsubsetR must be a valid array index /, "Got expected error message" ); { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcm->is_RsubsetL; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcm->is_BsubsetA; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } $eqv = $lcm->is_LequivalentR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcm->is_LeqvlntR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcm->is_LequivalentR(2,4); ok(! $eqv, "Got expected equivalence relationship"); eval { $eqv = $lcm->is_LequivalentR(2) }; like($@, qr/Method List::Compare::Multiple::is_LequivalentR requires 2 arguments/, "Got expected error message", ); eval { $eqv = $lcm->is_LequivalentR(8,9) }; like($@, qr/Each argument to method List::Compare::Multiple::is_LequivalentR must be a valid array index/, "Got expected error message", ); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcm->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcm->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); is_deeply( all_is_member_which( $lcm, \@args), $test_member_which_mult, "is_member_which() returned all expected values"); eval { $memb_arr_ref = $lcm->is_member_which('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which() correctly generated error message"); is_deeply( all_is_member_which_ref( $lcm, \@args), $test_member_which_mult, "is_member_which_ref() returned all expected values"); eval { $memb_arr_ref = $lcm->is_member_which_ref('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which_ref() correctly generated error message"); $memb_hash_ref = $lcm->are_members_which( \@args ); is_deeply($memb_hash_ref, $test_members_which_mult, "are_members_which() returned all expected values"); eval { $memb_hash_ref = $lcm->are_members_which( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_which() correctly generated error message"); is_deeply( all_is_member_any( $lcm, \@args), $test_member_any_mult, "is_member_which() returned all expected values"); eval { $lcm->is_member_any('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_any() correctly generated error message"); $memb_hash_ref = $lcm->are_members_any( \@args ); ok(wrap_are_members_any( $memb_hash_ref, $test_members_any_mult, ), "are_members_any() returned all expected values"); eval { $memb_hash_ref = $lcm->are_members_any( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_any() correctly generated error message"); $vers = $lcm->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lcm_dj = List::Compare->new(\%h0, \%h1, \%h2, \%h3, \%h4, \%h8); ok($lcm_dj, "Constructor returned true value"); $disj = $lcm_dj->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); $disj = $lcm_dj->is_LdisjointR(2,3); ok(! $disj, "Got expected disjoint relationship"); $disj = $lcm_dj->is_LdisjointR(4,5); ok($disj, "Got expected disjoint relationship"); eval { $disj = $lcm_dj->is_LdisjointR(2) }; like($@, qr/Method List::Compare::Multiple::is_LdisjointR requires 2 arguments/, "Got expected error message"); ########## BELOW: Testfor bad arguments to constructor ########## my ($lcm_bad); my $scalar = 'test'; eval { $lcm_bad = List::Compare->new(\$scalar, \%h0, \%h1) }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); List-Compare-0.53/t/29_oo_hashes_alt_mult_reg_sorted.t0000755000175000017500000004125212465263760022622 0ustar jkeenanjkeenan# perl #$Id$ # 29_oo_hashes_alt_mult_reg_sorted.t use strict; use Test::More tests => 104; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :hashes :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; ### new ### my $lcm = List::Compare->new( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ] } ); ok($lcm, "List::Compare constructor returned true value"); @pred = qw(abel baker camera delta edward fargo golfer hilton icon jerky); @union = $lcm->get_union; is_deeply( \@union, \@pred, "Got expected union"); $union_ref = $lcm->get_union_ref; is_deeply( $union_ref, \@pred, "Got expected union"); @pred = qw(baker camera delta edward fargo golfer hilton icon); @shared = $lcm->get_shared; is_deeply( \@shared, \@pred, "Got expected shared"); $shared_ref = $lcm->get_shared_ref; is_deeply( $shared_ref, \@pred, "Got expected shared"); @pred = qw(fargo golfer); @intersection = $lcm->get_intersection; is_deeply(\@intersection, \@pred, "Got expected intersection"); $intersection_ref = $lcm->get_intersection_ref; is_deeply($intersection_ref, \@pred, "Got expected intersection"); @pred = qw( jerky ); @unique = $lcm->get_unique(2); is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lcm->get_unique_ref(2); is_deeply($unique_ref, \@pred, "Got expected unique"); eval { $unique_ref = $lcm->get_unique_ref('jerky') }; like($@, qr/Argument to method List::Compare::Multiple::get_unique_ref must be the array index/, "Got expected error message" ); { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Lonly(2); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Lonly_ref(2); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Aonly(2); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Aonly_ref(2); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } @pred = qw( abel ); @unique = $lcm->get_unique; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lcm->get_unique_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Lonly(); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Lonly_ref(); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Aonly(); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Aonly_ref(); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } @pred = ( [ 'abel' ], [ ], [ 'jerky' ], [ ], [ ], ); $unique_all_ref = $lcm->get_unique_all(); is_deeply($unique_all_ref, [ @pred ], "Got expected values for get_unique_all()"); @pred = qw( abel icon jerky ); @complement = $lcm->get_complement(1); is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lcm->get_complement_ref(1); is_deeply($complement_ref, \@pred, "Got expected complement"); eval { $complement_ref = $lcm->get_complement_ref('jerky') }; like($@, qr/Argument to method List::Compare::Multiple::get_complement_ref must be the array index/, "Got expected error message" ); { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Ronly(1); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Ronly_ref(1); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Bonly(1); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Bonly_ref(1); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } @pred = qw ( hilton icon jerky ); @complement = $lcm->get_complement; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lcm->get_complement_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Ronly(); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Ronly_ref(); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Bonly(); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Bonly_ref(); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } @pred = ( [ qw( hilton icon jerky ) ], [ qw( abel icon jerky ) ], [ qw( abel baker camera delta edward ) ], [ qw( abel baker camera delta edward jerky ) ], [ qw( abel baker camera delta edward jerky ) ], ); $complement_all_ref = $lcm->get_complement_all(); is_deeply($complement_all_ref, [ @pred ], "Got expected values for get_complement_all()"); @pred = qw( abel jerky ); @symmetric_difference = $lcm->get_symmetric_difference; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lcm->get_symmetric_difference_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lcm->get_symdiff; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lcm->get_symdiff_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); { my ($rv, $stdout, $stderr); capture( sub { @symmetric_difference = $lcm->get_LorRonly; }, \$stdout, \$stderr, ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcm->get_LorRonly_ref; }, \$stdout, \$stderr, ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @symmetric_difference = $lcm->get_AorBonly; }, \$stdout, \$stderr, ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcm->get_AorBonly_ref; }, \$stdout, \$stderr, ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly_ref or its alias defaults/, "Got expected warning", ); } @pred = qw( abel baker camera delta edward hilton icon jerky ); @nonintersection = $lcm->get_nonintersection; is_deeply( \@nonintersection, \@pred, "Got expected nonintersection"); $nonintersection_ref = $lcm->get_nonintersection_ref; is_deeply($nonintersection_ref, \@pred, "Got expected nonintersection"); @pred = qw( abel abel baker baker camera camera delta delta delta edward edward fargo fargo fargo fargo fargo fargo golfer golfer golfer golfer golfer hilton hilton hilton hilton icon icon icon icon icon jerky ); @bag = $lcm->get_bag; is_deeply(\@bag, \@pred, "Got expected bag"); $bag_ref = $lcm->get_bag_ref; is_deeply($bag_ref, \@pred, "Got expected bag"); $LR = $lcm->is_LsubsetR(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcm->is_AsubsetB(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcm->is_LsubsetR(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcm->is_AsubsetB(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcm->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); eval { $LR = $lcm->is_LsubsetR(2) }; like($@, qr/Method List::Compare::Multiple::is_LsubsetR requires 2 arguments/, "Got expected error message" ); eval { $LR = $lcm->is_LsubsetR(8,9) }; like($@, qr/Each argument to method List::Compare::Multiple::is_LsubsetR must be a valid array index /, "Got expected error message" ); { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcm->is_RsubsetL; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcm->is_BsubsetA; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } $eqv = $lcm->is_LequivalentR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcm->is_LeqvlntR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcm->is_LequivalentR(2,4); ok(! $eqv, "Got expected equivalence relationship"); eval { $eqv = $lcm->is_LequivalentR(2) }; like($@, qr/Method List::Compare::Multiple::is_LequivalentR requires 2 arguments/, "Got expected error message", ); eval { $eqv = $lcm->is_LequivalentR(8,9) }; like($@, qr/Each argument to method List::Compare::Multiple::is_LequivalentR must be a valid array index/, "Got expected error message", ); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcm->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcm->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); is_deeply( all_is_member_which( $lcm, \@args), $test_member_which_mult, "is_member_which() returned all expected values"); eval { $memb_arr_ref = $lcm->is_member_which('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which() correctly generated error message"); is_deeply( all_is_member_which_ref( $lcm, \@args), $test_member_which_mult, "is_member_which_ref() returned all expected values"); eval { $memb_arr_ref = $lcm->is_member_which_ref('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which_ref() correctly generated error message"); $memb_hash_ref = $lcm->are_members_which( \@args ); is_deeply($memb_hash_ref, $test_members_which_mult, "are_members_which() returned all expected values"); eval { $memb_hash_ref = $lcm->are_members_which( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_which() correctly generated error message"); is_deeply( all_is_member_any( $lcm, \@args), $test_member_any_mult, "is_member_which() returned all expected values"); eval { $lcm->is_member_any('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_any() correctly generated error message"); $memb_hash_ref = $lcm->are_members_any( \@args ); ok(wrap_are_members_any( $memb_hash_ref, $test_members_any_mult, ), "are_members_any() returned all expected values"); eval { $memb_hash_ref = $lcm->are_members_any( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_any() correctly generated error message"); $vers = $lcm->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lcm_dj = List::Compare->new( { lists => [ \%h0, \%h1, \%h2, \%h3, \%h4, \%h8 ] } ); ok($lcm_dj, "Constructor returned true value"); $disj = $lcm_dj->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); $disj = $lcm_dj->is_LdisjointR(2,3); ok(! $disj, "Got expected disjoint relationship"); $disj = $lcm_dj->is_LdisjointR(4,5); ok($disj, "Got expected disjoint relationship"); eval { $disj = $lcm_dj->is_LdisjointR(2) }; like($@, qr/Method List::Compare::Multiple::is_LdisjointR requires 2 arguments/, "Got expected error message"); ########## BELOW: Testfor bad arguments to constructor ########## my ($lcm_bad); my $scalar = 'test'; eval { $lcm_bad = List::Compare->new( { lists => [ \$scalar, \%h0, \%h1 ] } ); }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); List-Compare-0.53/t/27_oo_hashes_alt_dual_acc_sorted.t0000755000175000017500000002450312465263760022535 0ustar jkeenanjkeenan# perl #$Id$ # 27_oo_hashes_alt_dual_acc_sorted.t use strict; use Test::More tests => 77; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :hashes :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; ### new ### my $lc = List::Compare->new( { accelerated => 1, lists => [ \%h0, \%h1 ], } ); ok($lc, "List::Compare constructor returned true value"); @pred = qw(abel baker camera delta edward fargo golfer hilton); @union = $lc->get_union; is_deeply( \@union, \@pred, "Got expected union"); $union_ref = $lc->get_union_ref; is_deeply( $union_ref, \@pred, "Got expected union"); { my ($rv, $stdout, $stderr); capture( sub { @shared = $lc->get_shared; }, \$stdout, \$stderr, ); is_deeply( \@shared, \@pred, "Got expected shared"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } { my ($rv, $stdout, $stderr); capture( sub { $shared_ref = $lc->get_shared_ref; }, \$stdout, \$stderr, ); is_deeply( $shared_ref, \@pred, "Got expected shared"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } @pred = qw( baker camera delta edward fargo golfer ); @intersection = $lc->get_intersection; is_deeply(\@intersection, \@pred, "Got expected intersection"); $intersection_ref = $lc->get_intersection_ref; is_deeply($intersection_ref, \@pred, "Got expected intersection"); @pred = qw( abel ); @unique = $lc->get_unique; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lc->get_unique_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); @unique = $lc->get_Lonly; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lc->get_Lonly_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); @unique = $lc->get_Aonly; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lc->get_Aonly_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); @pred = ( [ 'abel' ], [ 'hilton' ], ); $unique_all_ref = $lc->get_unique_all(); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_unique_all()"); @pred = qw ( hilton ); @complement = $lc->get_complement; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lc->get_complement_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); @complement = $lc->get_Ronly; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lc->get_Ronly_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); @complement = $lc->get_Bonly; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lc->get_Bonly_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); @pred = ( [ qw( hilton ) ], [ qw( abel ) ], ); $complement_all_ref = $lc->get_complement_all(); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); @pred = qw( abel hilton ); @symmetric_difference = $lc->get_symmetric_difference; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_symmetric_difference_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lc->get_symdiff; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_symdiff_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lc->get_LorRonly; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_LorRonly_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lc->get_AorBonly; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_AorBonly_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @pred = qw( abel hilton ); { my ($rv, $stdout, $stderr); capture( sub { @nonintersection = $lc->get_nonintersection; }, \$stdout, \$stderr, ); is_deeply( \@nonintersection, \@pred, "Got expected nonintersection"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } { my ($rv, $stdout, $stderr); capture( sub { $nonintersection_ref = $lc->get_nonintersection_ref; }, \$stdout, \$stderr, ); is_deeply($nonintersection_ref, \@pred, "Got expected nonintersection"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } @pred = qw( abel abel baker baker camera camera delta delta delta edward edward fargo fargo golfer golfer hilton ); @bag = $lc->get_bag; is_deeply(\@bag, \@pred, "Got expected bag"); $bag_ref = $lc->get_bag_ref; is_deeply($bag_ref, \@pred, "Got expected bag"); $LR = $lc->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); $LR = $lc->is_AsubsetB; ok(! $LR, "Got expected subset relationship"); $RL = $lc->is_RsubsetL; ok(! $RL, "Got expected subset relationship"); $RL = $lc->is_BsubsetA; ok(! $RL, "Got expected subset relationship"); $eqv = $lc->is_LequivalentR; ok(! $eqv, "Got expected equivalent relationship"); $eqv = $lc->is_LeqvlntR; ok(! $eqv, "Got expected equivalent relationship"); $disj = $lc->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lc->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lc->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } ok(wrap_is_member_which( $lc, $test_members_which, ), "is_member_which() returned all expected values"); eval { $memb_arr_ref = $lc->is_member_which('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which() correctly generated error message"); ok(wrap_is_member_which_ref( $lc, $test_members_which, ), "is_member_which_ref() returned all expected values"); eval { $memb_arr_ref = $lc->is_member_which_ref('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which_ref() correctly generated error message"); $memb_hash_ref = $lc->are_members_which( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); ok(wrap_are_members_which( $memb_hash_ref, $test_members_which, ), "are_members_which() returned all expected value"); eval { $memb_hash_ref = $lc->are_members_which( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_which() correctly generated error message"); ok(wrap_is_member_any( $lc, $test_members_any, ), "is_member_any() returned all expected values"); eval { $lc->is_member_any('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_any() correctly generated error message"); $memb_hash_ref = $lc->are_members_any( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); ok(wrap_are_members_any( $memb_hash_ref, $test_members_any, ), "are_members_any() returned all expected values"); eval { $memb_hash_ref = $lc->are_members_any( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_any() correctly generated error message"); $vers = $lc->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lc_s = List::Compare->new( { accelerated => 1, lists => [ \%h2, \%h3 ], } ); ok($lc_s, "constructor returned true value"); $LR = $lc_s->is_LsubsetR; ok(! $LR, "non-subset correctly determined"); $LR = $lc_s->is_AsubsetB; ok(! $LR, "non-subset correctly determined"); $RL = $lc_s->is_RsubsetL; ok($RL, "subset correctly determined"); $RL = $lc_s->is_BsubsetA; ok($RL, "subset correctly determined"); $eqv = $lc_s->is_LequivalentR; ok(! $eqv, "non-equivalence correctly determined"); $eqv = $lc_s->is_LeqvlntR; ok(! $eqv, "non-equivalence correctly determined"); $disj = $lc_s->is_LdisjointR; ok(! $disj, "non-disjoint correctly determined"); ### new ### my $lc_e = List::Compare->new( { accelerated => 1, lists => [ \%h3, \%h4 ], } ); ok($lc_e, "constructor returned true value"); $eqv = $lc_e->is_LequivalentR; ok($eqv, "equivalence correctly determined"); $eqv = $lc_e->is_LeqvlntR; ok($eqv, "equivalence correctly determined"); $disj = $lc_e->is_LdisjointR; ok(! $disj, "non-disjoint correctly determined"); ### new ### my $lc_dj = List::Compare->new( { accelerated => 1, lists => [ \%h4, \%h8 ], } ); ok($lc_dj, "constructor returned true value"); ok(0 == $lc_dj->get_intersection, "no intersection, as expected"); ok(0 == scalar(@{$lc_dj->get_intersection_ref}), "no intersection, as expected"); $disj = $lc_dj->is_LdisjointR; ok($disj, "disjoint correctly determined"); ########## BELOW: Test for bad arguments to constructor ########## my ($lc_bad); my $scalar = 'test'; eval { $lc_bad = List::Compare->new( { accelerated => 1, lists => [ \$scalar, \%h0 ], } ) }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); eval { $lc_bad = List::Compare->new( { accelerated => 1, lists => [ \%h0 ], } ) }; like($@, qr/Must pass at least 2 references/, "Got expected error message from bad constructor"); List-Compare-0.53/t/Test/0000755000175000017500000000000012535073324014736 5ustar jkeenanjkeenanList-Compare-0.53/t/Test/ListCompareSpecial.pm0000755000175000017500000003015712367245363021037 0ustar jkeenanjkeenanpackage Test::ListCompareSpecial; # Contains test subroutines for distribution with List::Compare require Exporter; our @ISA = qw(Exporter); our @EXPORT_OK = qw( ok_capture_error ok_seen_a ok_seen_h ok_any_h _capture getseen unseen wrap_is_member_which all_is_member_which func_all_is_member_which func_all_is_member_which_ref func_all_is_member_which_alt func_all_is_member_which_ref_alt wrap_is_member_which_ref all_is_member_which_ref wrap_are_members_which wrap_is_member_any all_is_member_any func_all_is_member_any func_all_is_member_any_alt wrap_are_members_any make_array_seen_hash @a0 @a1 @a2 @a3 @a4 @a8 %h0 %h1 %h2 %h3 %h4 %h5 %h6 %h7 %h8 $test_member_which_dual $test_member_which_mult $test_members_which $test_member_any_dual $test_member_any_mult $test_members_any $test_members_any_mult $test_members_which_mult func_wrap_is_member_which func_wrap_is_member_which_ref func_wrap_are_members_which func_wrap_is_member_any func_wrap_are_members_any ); our %EXPORT_TAGS = ( seen => [ qw( ok_capture_error ok_seen_a ok_seen_h ok_any_h _capture getseen unseen make_array_seen_hash ) ], wrap => [ qw( wrap_is_member_which all_is_member_which wrap_is_member_which_ref all_is_member_which_ref wrap_are_members_which wrap_is_member_any all_is_member_any wrap_are_members_any ) ], hashes => [ qw( %h0 %h1 %h2 %h3 %h4 %h5 %h6 %h7 %h8 ) ], arrays => [ qw( @a0 @a1 @a2 @a3 @a4 @a8 ) ], func_wrap => [ qw( func_wrap_is_member_which func_wrap_is_member_which_ref func_all_is_member_which_ref_alt func_all_is_member_which_alt func_wrap_are_members_which func_wrap_is_member_any func_wrap_are_members_any func_all_is_member_which func_all_is_member_which_ref func_all_is_member_any func_all_is_member_any_alt ) ], results => [ qw( $test_member_which_dual $test_member_which_mult $test_members_which $test_member_any_dual $test_member_any_mult $test_members_any $test_members_any_mult $test_members_which_mult ) ], ); use List::Compare::Functional qw( is_member_which is_member_which_ref is_member_any ); sub ok_capture_error { my $condition = shift; print "\nIGNORE PRINTOUT above during 'make test TEST_VERBOSE=1'\n testing for bad values\n"; return $condition; } sub ok_seen_h { die "Need 4 arguments: $!" unless (@_ == 4); my ($mhr, $arg, $quant_expect, $expected_ref) = @_; my (%seen, $score); $seen{$_}++ foreach (@{${$mhr}{$arg}}); $score++ if (keys %seen == $quant_expect); foreach (@{$expected_ref}) { $score++ if exists $seen{$_}; } $score == 1 + scalar(@{$expected_ref}) ? return 1 : return 0; } sub ok_seen_a { die "Need 4 arguments: $!" unless (@_ == 4); my ($mar, $arg, $quant_expect, $expected_ref) = @_; my (%seen, $score); $seen{$_}++ foreach (@{$mar}); $score++ if (keys %seen == $quant_expect); foreach (@{$expected_ref}) { $score++ if exists $seen{$_}; } $score == 1 + scalar(@{$expected_ref}) ? return 1 : return 0; } sub ok_any_h { die "Need 3 arguments: $!" unless (@_ == 3); my ($mhr, $arg, $expected) = @_; exists ${$mhr}{$arg} and ${$mhr}{$arg} == $expected ? return 1 : return 0; } sub _capture { my $str = $_[0]; } sub getseen { my $allref = shift; my @arr = @$allref; my (@seen); for (my $i=0; $i<=$#arr; $i++) { foreach my $j (@{$arr[$i]}) { $seen[$i]{$j}++; } } return @seen; } sub unseen { my ($seen, $nonexpected) = @_; my $errors = 0; foreach my $v ( @{ $nonexpected } ) { $errors++ if exists $seen->{$v}; } $errors ? 0 : 1; } sub wrap_is_member_which { my $obj = shift; my $args = shift; my $correct = 0; foreach my $v ( keys %{ $args } ) { my @found = $obj->is_member_which($v); $correct++ if ok_seen_a( \@found, $v, @{ $args->{$v} } ); } ($correct == scalar keys %{ $args }) ? 1 : 0; } sub all_is_member_which { my $obj = shift; my $args = shift; my @overall; for my $v ( @{ $args } ) { push @overall, [ $obj->is_member_which( $v ) ]; } return \@overall; } sub func_all_is_member_which { my $data = shift; my $args = shift; my @overall; for my $v ( @{ $args } ) { push @overall, [ is_member_which( $data, [ $v ] ) ]; } return \@overall; } sub func_all_is_member_which_alt { my $data = shift; my $args = shift; my @overall; for my $v ( @{ $args } ) { push @overall, [ is_member_which( { lists => $data, item => $v, } ) ]; } return \@overall; } sub func_all_is_member_which_ref_alt { my $data = shift; my $args = shift; my @overall; for my $v ( @{ $args } ) { push @overall, is_member_which_ref( { lists => $data, item => $v, } ); } return \@overall; } sub wrap_is_member_which_ref { my $obj = shift; my $args = shift; my $correct = 0; foreach my $v ( keys %{ $args } ) { my $memb_arr_ref = $obj->is_member_which_ref($v); $correct++ if ok_seen_a( $memb_arr_ref, $v, @{ $args->{$v} } ); } ($correct == scalar keys %{ $args }) ? 1 : 0; } sub all_is_member_which_ref { my $obj = shift; my $args = shift; my @overall; for my $v ( @{ $args } ) { push @overall, $obj->is_member_which_ref( $v ); } return \@overall; } sub func_all_is_member_which_ref { my $data = shift; my $args = shift; my @overall; for my $v ( @{ $args } ) { push @overall, is_member_which_ref( $data, [ $v ] ); } return \@overall; } sub wrap_are_members_which { my $memb_hash_ref = shift; my $args = shift; my $correct = 0; foreach my $v ( keys %{ $args } ) { $correct++ if ok_seen_h( $memb_hash_ref, $v, @{ $args->{$v} } ); } ($correct == scalar keys %{ $args }) ? 1 : 0; } sub wrap_is_member_any { my $obj = shift; my $args = shift; my $correct = 0; foreach my $v ( keys %{ $args } ) { $correct++ if ($obj->is_member_any( $v )) == $args->{$v}; } ($correct == scalar keys %{ $args }) ? 1 : 0; } #@args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); sub all_is_member_any { my $obj = shift; my $args = shift; my @overall; for my $v ( @{ $args } ) { push @overall, $obj->is_member_any( $v ); } return \@overall; } sub func_all_is_member_any { my $data = shift; my $args = shift; my @overall; for my $v ( @{ $args } ) { push @overall, is_member_any( $data, [ $v ] ); } return \@overall; } sub func_all_is_member_any_alt { my $data = shift; my $args = shift; my @overall; for my $v ( @{ $args } ) { push @overall, is_member_any( { lists => $data, item => $v, } ); } return \@overall; } sub wrap_are_members_any { my $memb_hash_ref = shift; my $args = shift; my $correct = 0; foreach my $v ( keys %{ $args } ) { $correct++ if ok_any_h( $memb_hash_ref, $v, $args->{$v} ); } ($correct == scalar keys %{ $args }) ? 1 : 0; } sub make_array_seen_hash { my $arrayref = shift; my @arrseen = (); foreach my $el (@{$arrayref}) { die "Each element must be an array ref" unless ref($el) eq 'ARRAY'; my %seen; $seen{$_}++ for @{$el}; push @arrseen, \%seen; } return \@arrseen; } @a0 = qw(abel abel baker camera delta edward fargo golfer); @a1 = qw(baker camera delta delta edward fargo golfer hilton); @a2 = qw(fargo golfer hilton icon icon jerky); @a3 = qw(fargo golfer hilton icon icon); @a4 = qw(fargo fargo golfer hilton icon); @a8 = qw(kappa lambda mu); %h0 = ( abel => 2, baker => 1, camera => 1, delta => 1, edward => 1, fargo => 1, golfer => 1, ); %h1 = ( baker => 1, camera => 1, delta => 2, edward => 1, fargo => 1, golfer => 1, hilton => 1, ); %h2 = ( fargo => 1, golfer => 1, hilton => 1, icon => 2, jerky => 1, ); %h3 = ( fargo => 1, golfer => 1, hilton => 1, icon => 2, ); %h4 = ( fargo => 2, golfer => 1, hilton => 1, icon => 1, ); %h5 = ( golfer => 1, lambda => 0, ); %h6 = ( golfer => 1, mu => 00, ); %h7 = ( golfer => 1, nu => 'nothing', ); %h8 = map {$_, 1} qw(kappa lambda mu); $test_member_which_dual = [ [ qw( 0 ) ], [ qw( 0 1 ) ], [ qw( 0 1 ) ], [ qw( 0 1 ) ], [ qw( 0 1 ) ], [ qw( 0 1 ) ], [ qw( 0 1 ) ], [ qw( 1 ) ], [ qw( ) ], [ qw( ) ], [ qw( ) ], ]; $test_member_which_mult = [ [ qw( 0 ) ], [ qw( 0 1 ) ], [ qw( 0 1 ) ], [ qw( 0 1 ) ], [ qw( 0 1 ) ], [ qw( 0 1 2 3 4 ) ], [ qw( 0 1 2 3 4 ) ], [ qw( 1 2 3 4 ) ], [ qw( 2 3 4 ) ], [ qw( 2 ) ], [ qw( ) ], ]; $test_members_which = { abel => [ 1, [ qw< 0 > ] ], baker => [ 2, [ qw< 0 1 > ] ], camera => [ 2, [ qw< 0 1 > ] ], delta => [ 2, [ qw< 0 1 > ] ], edward => [ 2, [ qw< 0 1 > ] ], fargo => [ 2, [ qw< 0 1 > ] ], golfer => [ 2, [ qw< 0 1 > ] ], hilton => [ 1, [ qw< 1 > ] ], icon => [ 0, [ qw< > ] ], jerky => [ 0, [ qw< > ] ], zebra => [ 0, [ qw< > ] ], }; $test_member_any_dual = [ 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0 ]; $test_member_any_mult = [ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0 ]; $test_members_any = { abel => 1, baker => 1, camera => 1, delta => 1, edward => 1, fargo => 1, golfer => 1, hilton => 1, icon => 0, jerky => 0, zebra => 0, }; $test_members_any_mult = { abel => 1, baker => 1, camera => 1, delta => 1, edward => 1, fargo => 1, golfer => 1, hilton => 1, icon => 1, jerky => 1, zebra => 0, }; $test_members_which_mult = { abel => [ qw< 0 > ], baker => [ qw< 0 1 > ], camera => [ qw< 0 1 > ], delta => [ qw< 0 1 > ], edward => [ qw< 0 1 > ], fargo => [ qw< 0 1 2 3 4 > ], golfer => [ qw< 0 1 2 3 4 > ], hilton => [ qw< 1 2 3 4 > ], icon => [ qw< 2 3 4 > ], jerky => [ qw< 2 > ], zebra => [ qw< > ], }; sub func_wrap_is_member_which { my $data = shift; my $args = shift; my $correct = 0; foreach my $v ( keys %{ $args } ) { my @found = is_member_which( $data, [ $v ]); $correct++ if ok_seen_a( \@found, $v, @{ $args->{$v} } ); } ($correct == scalar keys %{ $args }) ? 1 : 0; } sub func_wrap_is_member_which_ref { my $data = shift; my $args = shift; my $correct = 0; foreach my $v ( keys %{ $args } ) { my $memb_arr_ref = is_member_which_ref( $data, [ $v ]); $correct++ if ok_seen_a( $memb_arr_ref, $v, @{ $args->{$v} } ); } ($correct == scalar keys %{ $args }) ? 1 : 0; } sub func_wrap_are_members_which { my $memb_hash_ref = shift; my $args = shift; my $correct = 0; foreach my $v ( keys %{ $args } ) { $correct++ if ok_seen_h( $memb_hash_ref, $v, @{ $args->{$v} } ); } ($correct == scalar keys %{ $args }) ? 1 : 0; } sub func_wrap_is_member_any { my $data = shift; my $args = shift; my $correct = 0; foreach my $v ( keys %{ $args } ) { $correct++ if (is_member_any( $data, [ $v ])) == $args->{$v}; } ($correct == scalar keys %{ $args }) ? 1 : 0; } sub func_wrap_are_members_any { my $memb_hash_ref = shift; my $args = shift; my $correct = 0; foreach my $v ( keys %{ $args } ) { $correct++ if ok_any_h( $memb_hash_ref, $v, $args->{$v} ); } ($correct == scalar keys %{ $args }) ? 1 : 0; } List-Compare-0.53/t/37_func_lists_alt_dual_sorted.t0000755000175000017500000001741612465263760022136 0ustar jkeenanjkeenan# perl #$Id$ # 37_func_lists_alt_dual_sorted.t use strict; use Test::More tests => 50; use List::Compare::Functional qw(:originals :aliases); use lib ("./t"); use Test::ListCompareSpecial qw( :seen :func_wrap :arrays :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref); my @args; @pred = qw(abel baker camera delta edward fargo golfer hilton); @union = get_union( { lists => [ \@a0, \@a1 ] } ); is_deeply( \@union, \@pred, "Got expected union"); $union_ref = get_union_ref( { lists => [ \@a0, \@a1 ] } ); is_deeply( $union_ref, \@pred, "Got expected union"); @pred = qw( baker camera delta edward fargo golfer ); @shared = get_shared( { lists => [ \@a0, \@a1 ] } ); is_deeply( \@shared, \@pred, "Got expected shared"); $shared_ref = get_shared_ref( { lists => [ \@a0, \@a1 ] } ); is_deeply( $shared_ref, \@pred, "Got expected shared"); @pred = qw( baker camera delta edward fargo golfer ); @intersection = get_intersection( { lists => [ \@a0, \@a1 ] } ); is_deeply(\@intersection, \@pred, "Got expected intersection"); $intersection_ref = get_intersection_ref( { lists => [ \@a0, \@a1 ] } ); is_deeply($intersection_ref, \@pred, "Got expected intersection"); @pred = qw( abel ); @unique = get_unique( { lists => [ \@a0, \@a1 ] } ); is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = get_unique_ref( { lists => [ \@a0, \@a1 ] } ); is_deeply($unique_ref, \@pred, "Got expected unique"); @pred = ( [ 'abel' ], [ 'hilton' ], ); $unique_all_ref = get_unique_all( { lists => [ \@a0, \@a1 ] } ); is_deeply($unique_all_ref, [ @pred ], "Got expected values for get_unique_all()"); @pred = qw ( hilton ); @complement = get_complement( { lists => [ \@a0, \@a1 ] } ); is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = get_complement_ref( { lists => [ \@a0, \@a1 ] } ); is_deeply($complement_ref, \@pred, "Got expected complement"); @pred = ( [ qw( hilton ) ], [ qw( abel ) ], ); $complement_all_ref = get_complement_all( { lists => [ \@a0, \@a1 ] } ); is_deeply($complement_all_ref, [ @pred ], "Got expected values for get_complement_all()"); @pred = qw( abel hilton ); @symmetric_difference = get_symmetric_difference( { lists => [ \@a0, \@a1 ] } ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = get_symmetric_difference_ref( { lists => [ \@a0, \@a1 ] } ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = get_symdiff( { lists => [ \@a0, \@a1 ] } ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = get_symdiff_ref( { lists => [ \@a0, \@a1 ] } ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @pred = qw( abel hilton ); @nonintersection = get_nonintersection( { lists => [ \@a0, \@a1 ] } ); is_deeply(\@nonintersection, \@pred, "Got expected nonintersection"); $nonintersection_ref = get_nonintersection_ref( { lists => [ \@a0, \@a1 ] } ); is_deeply($nonintersection_ref, \@pred, "Got expected nonintersection"); @pred = qw( abel abel baker baker camera camera delta delta delta edward edward fargo fargo golfer golfer hilton ); @bag = get_bag( { lists => [ \@a0, \@a1 ] } ); is_deeply(\@bag, \@pred, "Got expected bag"); $bag_ref = get_bag_ref( { lists => [ \@a0, \@a1 ] } ); is_deeply($bag_ref, \@pred, "Got expected bag"); $LR = is_LsubsetR( { lists => [ \@a0, \@a1 ] } ); ok(! $LR, "Got expected subset relationship"); $RL = is_RsubsetL( { lists => [ \@a0, \@a1 ] } ); ok(! $RL, "Got expected subset relationship"); $eqv = is_LequivalentR( { lists => [ \@a0, \@a1 ] } ); ok(! $eqv, "Got expected equivalent relationship"); $eqv = is_LeqvlntR( { lists => [ \@a0, \@a1 ] } ); ok(! $eqv, "Got expected equivalent relationship"); $disj = is_LdisjointR( { lists => [ \@a0, \@a1 ] } ); ok(! $disj, "Got expected disjoint relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = print_subset_chart( { lists => [ \@a0, \@a1 ] } ); }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } my $scalar = q{string}; eval { my $rv = print_subset_chart( { lists => \$scalar } ); }; like($@, qr/^Need to define 'lists' key properly/, "Got expected error message re value for 'lists' key other than array ref"); eval { my $rv = print_subset_chart( { key => 'value' } ); }; like($@, qr/^Need to define 'lists' key properly/, "Got expected error message re value for 'lists' key other than array ref"); { my ($rv, $stdout, $stderr); capture( sub { $rv = print_equivalence_chart( { lists => [ \@a0, \@a1 ] } ); }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } eval { my $rv = print_equivalence_chart( { lists => \$scalar } ); }; like($@, qr/^Need to define 'lists' key properly/, "Got expected error message re value for 'lists' key other than array ref"); eval { my $rv = print_equivalence_chart( { key => 'value' } ); }; like($@, qr/^Need to define 'lists' key properly/, "Got expected error message re value for 'lists' key other than array ref"); @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); is_deeply(func_all_is_member_which_alt( [ \@a0, \@a1 ], \@args ), $test_member_which_dual, "is_member_which() returned all expected values"); is_deeply(func_all_is_member_which_ref_alt( [ \@a0, \@a1 ], \@args ), $test_member_which_dual, "is_member_which() returned all expected values"); $memb_hash_ref = are_members_which( { lists => [ \@a0, \@a1 ], items => \@args, } ); ok(func_wrap_are_members_which( $memb_hash_ref, $test_members_which, ), "are_members_which() returned all expected values"); is_deeply(func_all_is_member_any( [ \@a0, \@a1 ], \@args ), $test_member_any_dual, "is_member_any() returned all expected values"); $memb_hash_ref = are_members_any( { lists => [ \@a0, \@a1 ], items => \@args, } ); ok(func_wrap_are_members_any( $memb_hash_ref, $test_members_any, ), "are_members_any() returned all expected values"); $vers = get_version; ok($vers, "get_version() returned true value"); $LR = is_LsubsetR( { lists => [ \@a2, \@a3 ] } ); ok(! $LR, "non-subset correctly determined"); $RL = is_RsubsetL( { lists => [ \@a2, \@a3 ] } ); ok($RL, "subset correctly determined"); $eqv = is_LequivalentR( { lists => [ \@a2, \@a3 ] } ); ok(! $eqv, "non-equivalence correctly determined"); $eqv = is_LeqvlntR( { lists => [ \@a2, \@a3 ] } ); ok(! $eqv, "non-equivalence correctly determined"); $disj = is_LdisjointR( { lists => [ \@a2, \@a3 ] } ); ok(! $disj, "non-disjoint correctly determined"); $eqv = is_LequivalentR( { lists => [ \@a3, \@a4 ] } ); ok($eqv, "equivalence correctly determined"); $eqv = is_LeqvlntR( { lists => [ \@a3, \@a4 ] } ); ok($eqv, "equivalence correctly determined"); $disj = is_LdisjointR( { lists => [ \@a3, \@a4 ] } ); ok(! $disj, "non-disjoint correctly determined"); ok(0 == get_intersection( { lists => [ \@a4, \@a8 ] } ), "no intersection, as expected"); ok(0 == scalar(@{get_intersection_ref( { lists => [ \@a4, \@a8 ] } )}), "no intersection, as expected"); $disj = is_LdisjointR( { lists => [ \@a4, \@a8 ] } ); ok($disj, "disjoint correctly determined"); List-Compare-0.53/t/44_func_hashes_mult_unsorted.t0000755000175000017500000002032412465263760022000 0ustar jkeenanjkeenan# perl #$Id$ # 36_func_lists_mult_unsorted.t use strict; use Test::More tests => 42; use List::Compare::Functional qw(:originals :aliases); use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :hashes :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton icon jerky ); @unpred = qw| kappa |; @union = get_union( '-u', [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); $seen{$_}++ foreach (@union); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); $union_ref = get_union_ref( '-u', [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); $seen{$_}++ foreach (@{$union_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer hilton icon ); @unpred = qw| abel jerky |; @shared = get_shared( '-u', [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); $seen{$_}++ foreach (@shared); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); $shared_ref = get_shared_ref( '-u', [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); $seen{$_}++ foreach (@{$shared_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( fargo golfer ); @unpred = qw| abel baker camera delta edward hilton icon jerky |; @intersection = get_intersection( '-u', [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); $seen{$_}++ foreach (@intersection); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); $intersection_ref = get_intersection_ref( '-u', [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); $seen{$_}++ foreach (@{$intersection_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( jerky ); @unpred = qw| abel baker camera delta edward fargo golfer hilton icon |; @unique = get_unique( '-u', [ \%h0, \%h1, \%h2, \%h3, \%h4 ], [ 2 ] ); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = get_unique_ref( '-u', [ \%h0, \%h1, \%h2, \%h3, \%h4 ], [ 2 ] ); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ 'abel' ], [ ], [ 'jerky' ], [ ], [ ], ); $unique_all_ref = get_unique_all( '-u', [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %pred = map {$_, 1} qw( abel icon jerky ); @unpred = qw| baker camera delta edward fargo golfer hilton |; @complement = get_complement( '-u', [ \%h0, \%h1, \%h2, \%h3, \%h4 ], [ 1 ] ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = get_complement_ref( '-u', [ \%h0, \%h1, \%h2, \%h3, \%h4 ], [ 1 ] ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( hilton icon jerky ); @unpred = qw| abel baker camera delta edward fargo golfer |; @complement = get_complement( '-u', [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = get_complement_ref( '-u', [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel jerky ); @unpred = qw| baker camera delta edward fargo golfer hilton icon |; @symmetric_difference = get_symmetric_difference( '-u', [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = get_symmetric_difference_ref( '-u', [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = get_symdiff( '-u', [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = get_symdiff_ref( '-u', [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ qw( hilton icon jerky ) ], [ qw( abel icon jerky ) ], [ qw( abel baker camera delta edward ) ], [ qw( abel baker camera delta edward jerky ) ], [ qw( abel baker camera delta edward jerky ) ], ); $complement_all_ref = get_complement_all( '-u', [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %seen = (); %pred = map {$_, 1} qw( abel baker camera delta edward hilton icon jerky ); @unpred = qw| fargo golfer |; @nonintersection = get_nonintersection( '-u', [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); $seen{$_}++ foreach (@nonintersection); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); $nonintersection_ref = get_nonintersection_ref( '-u', [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); $seen{$_}++ foreach (@{$nonintersection_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); %pred = ( abel => 2, baker => 2, camera => 2, delta => 3, edward => 2, fargo => 6, golfer => 5, hilton => 4, icon => 5, jerky => 1, ); @unpred = qw| kappa |; @bag = get_bag( '-u', [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); $seen{$_}++ foreach (@bag); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $bag_ref = get_bag_ref( '-u', [ \%h0, \%h1, \%h2, \%h3, \%h4 ] ); $seen{$_}++ foreach (@{$bag_ref}); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); List-Compare-0.53/t/32_oo_hashes_alt_mult_acc_unsorted.t0000755000175000017500000004357212465263760023137 0ustar jkeenanjkeenan# perl #$Id$ # 32_oo_hashes_alt_mult_acc_unsorted.t use strict; use Test::More tests => 110; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :hashes :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; ### new ### my $lcmu = List::Compare->new( { unsorted =>1, accelerated => 1, lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], } ); ok($lcmu, "List::Compare constructor returned true value"); %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton icon jerky ); @unpred = qw| kappa |; @union = $lcmu->get_union; $seen{$_}++ foreach (@union); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); $union_ref = $lcmu->get_union_ref; $seen{$_}++ foreach (@{$union_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer hilton icon ); @unpred = qw| abel jerky |; @shared = $lcmu->get_shared; $seen{$_}++ foreach (@shared); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); $shared_ref = $lcmu->get_shared_ref; $seen{$_}++ foreach (@{$shared_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( fargo golfer ); @unpred = qw| abel baker camera delta edward hilton icon jerky |; @intersection = $lcmu->get_intersection; $seen{$_}++ foreach (@intersection); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); $intersection_ref = $lcmu->get_intersection_ref; $seen{$_}++ foreach (@{$intersection_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( jerky ); @unpred = qw| abel baker camera delta edward fargo golfer hilton icon |; @unique = $lcmu->get_unique(2); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcmu->get_unique_ref(2); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @unique = $lcmu->get_Lonly(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $unique_ref = $lcmu->get_Lonly_ref(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { @unique = $lcmu->get_Aonly(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $unique_ref = $lcmu->get_Aonly_ref(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); @pred = ( [ 'abel' ], [ ], [ 'jerky' ], [ ], [ ], ); $unique_all_ref = $lcmu->get_unique_all(); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_unique_all()"); %pred = map {$_, 1} qw( abel icon jerky ); @unpred = qw| baker camera delta edward fargo golfer hilton |; @complement = $lcmu->get_complement(1); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcmu->get_complement_ref(1); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @complement = $lcmu->get_Bonly(1); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $complement_ref = $lcmu->get_Bonly_ref(1); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); %pred = map {$_, 1} qw( hilton icon jerky ); @unpred = qw| abel baker camera delta edward fargo golfer |; @complement = $lcmu->get_complement; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcmu->get_complement_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @complement = $lcmu->get_Ronly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $complement_ref = $lcmu->get_Ronly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { @complement = $lcmu->get_Bonly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $complement_ref = $lcmu->get_Bonly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); %pred = map {$_, 1} qw( abel jerky ); @unpred = qw| baker camera delta edward fargo golfer hilton icon |; @symmetric_difference = $lcmu->get_symmetric_difference; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcmu->get_symmetric_difference_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcmu->get_symdiff; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcmu->get_symdiff_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @symmetric_difference = $lcmu->get_LorRonly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } %seen = (); { my ($stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcmu->get_LorRonly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); } %seen = (); { my ($stdout, $stderr); capture( sub { @symmetric_difference = $lcmu->get_AorBonly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } %seen = (); { my ($stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcmu->get_AorBonly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); } %seen = (); @pred = ( [ qw( hilton icon jerky ) ], [ qw( abel icon jerky ) ], [ qw( abel baker camera delta edward ) ], [ qw( abel baker camera delta edward jerky ) ], [ qw( abel baker camera delta edward jerky ) ], ); $complement_all_ref = $lcmu->get_complement_all(); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %pred = map {$_, 1} qw( abel baker camera delta edward hilton icon jerky ); @unpred = qw| fargo golfer |; @nonintersection = $lcmu->get_nonintersection; $seen{$_}++ foreach (@nonintersection); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); $nonintersection_ref = $lcmu->get_nonintersection_ref; $seen{$_}++ foreach (@{$nonintersection_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); %pred = ( abel => 2, baker => 2, camera => 2, delta => 3, edward => 2, fargo => 6, golfer => 5, hilton => 4, icon => 5, jerky => 1, ); @unpred = qw| kappa |; @bag = $lcmu->get_bag; $seen{$_}++ foreach (@bag); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $bag_ref = $lcmu->get_bag_ref; $seen{$_}++ foreach (@{$bag_ref}); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $LR = $lcmu->is_LsubsetR(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcmu->is_AsubsetB(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcmu->is_LsubsetR(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcmu->is_AsubsetB(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcmu->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcmu->is_RsubsetL; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcmu->is_BsubsetA; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } $eqv = $lcmu->is_LequivalentR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcmu->is_LeqvlntR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcmu->is_LequivalentR(2,4); ok(! $eqv, "Got expected equivalence relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcmu->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcmu->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); is_deeply( all_is_member_which( $lcmu, \@args), $test_member_which_mult, "is_member_which() returned all expected values"); is_deeply( all_is_member_which_ref( $lcmu, \@args), $test_member_which_mult, "is_member_which_ref() returned all expected values"); $memb_hash_ref = $lcmu->are_members_which( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); is_deeply($memb_hash_ref, $test_members_which_mult, "are_members_which() returned all expected values"); is_deeply( all_is_member_any( $lcmu, \@args), $test_member_any_mult, "is_member_which() returned all expected values"); $memb_hash_ref = $lcmu->are_members_any( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); is_deeply($memb_hash_ref, $test_members_any_mult, "are_members_any() returned all expected values"); $vers = $lcmu->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lcmu_dj = List::Compare->new( { unsorted =>1, accelerated => 1, lists => [ \%h0, \%h1, \%h2, \%h3, \%h4, \%h8 ], } ); ok($lcmu_dj, "List::Compare constructor returned true value"); $disj = $lcmu_dj->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); $disj = $lcmu_dj->is_LdisjointR(2,3); ok(! $disj, "Got expected disjoint relationship"); $disj = $lcmu_dj->is_LdisjointR(4,5); ok($disj, "Got expected disjoint relationship"); ########## BELOW: Test for '--unsorted' option ########## my $lcmuna = List::Compare->new( { unsorted =>1, accelerated => 1, lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], } ); ok($lcmuna, "List::Compare constructor returned true value"); List-Compare-0.53/t/08_oo_lists_mult_acc_unsorted.t0000755000175000017500000004360712471220765022157 0ustar jkeenanjkeenan# perl #$Id$ # 08_oo_lists_mult_acc_unsorted.t use strict; use Test::More tests => 111; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :arrays :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; ### new ### my $lcmu = List::Compare->new('-u', '-a', \@a0, \@a1, \@a2, \@a3, \@a4); ok($lcmu, "List::Compare constructor returned true value"); %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton icon jerky ); @unpred = qw| kappa |; @union = $lcmu->get_union; $seen{$_}++ foreach (@union); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); $union_ref = $lcmu->get_union_ref; $seen{$_}++ foreach (@{$union_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer hilton icon ); @unpred = qw| abel jerky |; @shared = $lcmu->get_shared; $seen{$_}++ foreach (@shared); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); $shared_ref = $lcmu->get_shared_ref; $seen{$_}++ foreach (@{$shared_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( fargo golfer ); @unpred = qw| abel baker camera delta edward hilton icon jerky |; @intersection = $lcmu->get_intersection; $seen{$_}++ foreach (@intersection); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); $intersection_ref = $lcmu->get_intersection_ref; $seen{$_}++ foreach (@{$intersection_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( jerky ); @unpred = qw| abel baker camera delta edward fargo golfer hilton icon |; @unique = $lcmu->get_unique(2); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcmu->get_unique_ref(2); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @unique = $lcmu->get_Lonly(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $unique_ref = $lcmu->get_Lonly_ref(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { @unique = $lcmu->get_Aonly(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $unique_ref = $lcmu->get_Aonly_ref(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); @pred = ( [ 'abel' ], [ ], [ 'jerky' ], [ ], [ ], ); $unique_all_ref = $lcmu->get_unique_all(); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_unique_all()"); %pred = map {$_, 1} qw( abel icon jerky ); @unpred = qw| baker camera delta edward fargo golfer hilton |; @complement = $lcmu->get_complement(1); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcmu->get_complement_ref(1); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @complement = $lcmu->get_Bonly(1); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $complement_ref = $lcmu->get_Bonly_ref(1); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); %pred = map {$_, 1} qw( hilton icon jerky ); @unpred = qw| abel baker camera delta edward fargo golfer |; @complement = $lcmu->get_complement; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcmu->get_complement_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @complement = $lcmu->get_Ronly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $complement_ref = $lcmu->get_Ronly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { @complement = $lcmu->get_Bonly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $complement_ref = $lcmu->get_Bonly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); %pred = map {$_, 1} qw( abel jerky ); @unpred = qw| baker camera delta edward fargo golfer hilton icon |; @symmetric_difference = $lcmu->get_symmetric_difference; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcmu->get_symmetric_difference_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcmu->get_symdiff; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcmu->get_symdiff_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @symmetric_difference = $lcmu->get_LorRonly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } %seen = (); { my ($stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcmu->get_LorRonly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); } %seen = (); { my ($stdout, $stderr); capture( sub { @symmetric_difference = $lcmu->get_AorBonly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } %seen = (); { my ($stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcmu->get_AorBonly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); } %seen = (); @pred = ( [ qw( hilton icon jerky ) ], [ qw( abel icon jerky ) ], [ qw( abel baker camera delta edward ) ], [ qw( abel baker camera delta edward jerky ) ], [ qw( abel baker camera delta edward jerky ) ], ); $complement_all_ref = $lcmu->get_complement_all(); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %pred = map {$_, 1} qw( abel baker camera delta edward hilton icon jerky ); @unpred = qw| fargo golfer |; @nonintersection = $lcmu->get_nonintersection; $seen{$_}++ foreach (@nonintersection); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); $nonintersection_ref = $lcmu->get_nonintersection_ref; $seen{$_}++ foreach (@{$nonintersection_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); %pred = ( abel => 2, baker => 2, camera => 2, delta => 3, edward => 2, fargo => 6, golfer => 5, hilton => 4, icon => 5, jerky => 1, ); @unpred = qw| kappa |; @bag = $lcmu->get_bag; $seen{$_}++ foreach (@bag); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $bag_ref = $lcmu->get_bag_ref; $seen{$_}++ foreach (@{$bag_ref}); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $LR = $lcmu->is_LsubsetR(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcmu->is_AsubsetB(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcmu->is_LsubsetR(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcmu->is_AsubsetB(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcmu->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcmu->is_RsubsetL; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcmu->is_BsubsetA; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } $eqv = $lcmu->is_LequivalentR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcmu->is_LeqvlntR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcmu->is_LequivalentR(2,4); ok(! $eqv, "Got expected equivalence relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcmu->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcmu->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); is_deeply( all_is_member_which( $lcmu, \@args), $test_member_which_mult, "is_member_which() returned all expected values"); is_deeply( all_is_member_which_ref( $lcmu, \@args), $test_member_which_mult, "is_member_which_ref() returned all expected values"); $memb_hash_ref = $lcmu->are_members_which( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); is_deeply($memb_hash_ref, $test_members_which_mult, "are_members_which() returned all expected values"); is_deeply( all_is_member_any( $lcmu, \@args), $test_member_any_mult, "is_member_which() returned all expected values"); $memb_hash_ref = $lcmu->are_members_any( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); is_deeply($memb_hash_ref, $test_members_any_mult, "are_members_any() returned all expected values"); $vers = $lcmu->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lcmu_dj = List::Compare->new('-u', '-a', \@a0, \@a1, \@a2, \@a3, \@a4, \@a8); ok($lcmu_dj, "List::Compare constructor returned true value"); $disj = $lcmu_dj->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); $disj = $lcmu_dj->is_LdisjointR(2,3); ok(! $disj, "Got expected disjoint relationship"); $disj = $lcmu_dj->is_LdisjointR(4,5); ok($disj, "Got expected disjoint relationship"); ########## BELOW: Test for '--unsorted' option ########## my $lcmuna = List::Compare->new( '--unsorted', '-a', \@a0, \@a1, \@a2, \@a3, \@a4); ok($lcmuna, "List::Compare constructor returned true value"); $lcmuna = List::Compare->new( '--unsorted', '--accelerated', \@a0, \@a1, \@a2, \@a3, \@a4); ok($lcmuna, "List::Compare constructor returned true value"); List-Compare-0.53/t/18_oo_hashes_dual_reg_unsorted.t0000755000175000017500000003373312465263760022274 0ustar jkeenanjkeenan# perl #$Id$ # 18_oo_hashes_dual_reg_unsorted.t use strict; use Test::More tests => 103; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :hashes :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; ########## BELOW: Tests for '-u' option ########## ### new ### my $lcu = List::Compare->new('-u', \%h0, \%h1); ok($lcu, "constructor returned true value"); %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton ); @unpred = qw| icon jerky |; @union = $lcu->get_union; $seen{$_}++ foreach (@union); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); $union_ref = $lcu->get_union_ref; $seen{$_}++ foreach (@{$union_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer ); @unpred = qw| abel hilton icon jerky |; @intersection = $lcu->get_intersection; $seen{$_}++ foreach (@intersection); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); $intersection_ref = $lcu->get_intersection_ref; $seen{$_}++ foreach (@{$intersection_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); { my ($rv, $stdout, $stderr); capture( sub { @shared = $lcu->get_shared; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@shared); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); { my ($rv, $stdout, $stderr); capture( sub { $shared_ref = $lcu->get_shared_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$shared_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); %pred = map {$_, 1} qw( abel ); @unpred = qw| baker camera delta edward fargo golfer hilton icon jerky |; @unique = $lcu->get_unique; $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcu->get_unique_ref; $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @unique = $lcu->get_Lonly; $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcu->get_Lonly_ref; $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @unique = $lcu->get_Aonly; $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcu->get_Aonly_ref; $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ 'abel' ], [ 'hilton' ], ); $unique_all_ref = $lcu->get_unique_all(); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %pred = map {$_, 1} qw( hilton ); @unpred = qw| abel baker camera delta edward fargo golfer icon jerky |; @complement = $lcu->get_complement; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcu->get_complement_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @complement = $lcu->get_Ronly; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcu->get_Ronly_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @complement = $lcu->get_Bonly; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcu->get_Bonly_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ qw( hilton ) ], [ qw( abel ) ], ); $complement_all_ref = $lcu->get_complement_all(); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %pred = map {$_, 1} qw( abel hilton ); @unpred = qw| baker camera delta edward fargo golfer icon jerky |; @symmetric_difference = $lcu->get_symmetric_difference; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_symmetric_difference_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcu->get_symdiff; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_symdiff_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcu->get_LorRonly; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_LorRonly_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcu->get_AorBonly; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_AorBonly_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel hilton ); @unpred = qw| baker camera delta edward fargo golfer icon jerky |; { my ($rv, $stdout, $stderr); capture( sub { @nonintersection = $lcu->get_nonintersection; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@nonintersection); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); { my ($rv, $stdout, $stderr); capture( sub { $nonintersection_ref = $lcu->get_nonintersection_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$nonintersection_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); %pred = ( abel => 2, baker => 2, camera => 2, delta => 3, edward => 2, fargo => 2, golfer => 2, hilton => 1, ); @unpred = qw| icon jerky |; @bag = $lcu->get_bag; $seen{$_}++ foreach (@bag); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $bag_ref = $lcu->get_bag_ref; $seen{$_}++ foreach (@{$bag_ref}); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $LR = $lcu->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); $LR = $lcu->is_AsubsetB; ok(! $LR, "Got expected subset relationship"); $RL = $lcu->is_RsubsetL; ok(! $RL, "Got expected subset relationship"); $RL = $lcu->is_BsubsetA; ok(! $RL, "Got expected subset relationship"); $eqv = $lcu->is_LequivalentR; ok(! $eqv, "Got expected equivalent relationship"); $eqv = $lcu->is_LeqvlntR; ok(! $eqv, "Got expected equivalent relationship"); $disj = $lcu->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcu->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcu->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } ok(wrap_is_member_which( $lcu, $test_members_which, ), "is_member_which() returned all expected values"); ok(wrap_is_member_which_ref( $lcu, $test_members_which, ), "is_member_which_ref() returned all expected values"); @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); $memb_hash_ref = $lcu->are_members_which( \@args ); ok(wrap_are_members_which( $memb_hash_ref, $test_members_which, ), "are_members_which() returned all expected value"); ok(wrap_is_member_any( $lcu, $test_members_any, ), "is_member_any() returned all expected values"); $memb_hash_ref = $lcu->are_members_any( \@args ); ok(wrap_are_members_any( $memb_hash_ref, $test_members_any, ), "are_members_any() returned all expected values"); $vers = $lcu->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lcu_s = List::Compare->new('-u', \%h2, \%h3); ok($lcu_s, "constructor returned true value"); $LR = $lcu_s->is_LsubsetR; ok(! $LR, "non-subset correctly determined"); $LR = $lcu_s->is_AsubsetB; ok(! $LR, "non-subset correctly determined"); $RL = $lcu_s->is_RsubsetL; ok($RL, "subset correctly determined"); $RL = $lcu_s->is_BsubsetA; ok($RL, "subset correctly determined"); $eqv = $lcu_s->is_LequivalentR; ok(! $eqv, "non-equivalence correctly determined"); $eqv = $lcu_s->is_LeqvlntR; ok(! $eqv, "non-equivalence correctly determined"); $disj = $lcu_s->is_LdisjointR; ok(! $disj, "non-disjoint correctly determined"); ### new ### my $lcu_e = List::Compare->new('-u', \%h3, \%h4); ok($lcu_e, "constructor returned true value"); $eqv = $lcu_e->is_LequivalentR; ok($eqv, "Got expected equivalent relationship"); $eqv = $lcu_e->is_LeqvlntR; ok($eqv, "Got expected equivalent relationship"); $disj = $lcu_e->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); ### new ### my $lcu_dj = List::Compare->new('-u', \%h4, \%h8); ok($lcu_dj, "constructor returned true value"); ok(0 == $lcu_dj->get_intersection, "no intersection, as expected"); ok(0 == scalar(@{$lcu_dj->get_intersection_ref}), "no intersection, as expected"); $disj = $lcu_dj->is_LdisjointR; ok($disj, "disjoint correctly determined"); ########## BELOW: Tests for '--unsorted' option ########## my $lcun = List::Compare->new('--unsorted', \%h0, \%h1); ok($lcun, "constructor returned true value"); my $lcun_s = List::Compare->new('--unsorted', \%h2, \%h3); ok($lcun_s, "constructor returned true value"); my $lcun_e = List::Compare->new('--unsorted', \%h3, \%h4); ok($lcun_e, "constructor returned true value"); List-Compare-0.53/t/04_oo_lists_dual_acc_unsorted.t0000755000175000017500000003575212465263760022126 0ustar jkeenanjkeenan# perl #$Id$ # 04_oo_lists_dual_acc_unsorted.t use strict; use Test::More tests => 109; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :arrays :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; ### new ### my $lcu = List::Compare->new('-u', '-a', \@a0, \@a1); ok($lcu, "constructor returned true value"); %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton ); @unpred = qw| icon jerky |; @union = $lcu->get_union; $seen{$_}++ foreach (@union); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); $union_ref = $lcu->get_union_ref; $seen{$_}++ foreach (@{$union_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton ); { my ($rv, $stdout, $stderr); capture( sub { @shared = $lcu->get_shared; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@shared); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); { my ($rv, $stdout, $stderr); capture( sub { $shared_ref = $lcu->get_shared_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$shared_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer ); @unpred = qw| abel hilton icon jerky |; @intersection = $lcu->get_intersection; $seen{$_}++ foreach (@intersection); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); $intersection_ref = $lcu->get_intersection_ref; $seen{$_}++ foreach (@{$intersection_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel ); @unpred = qw| baker camera delta edward fargo golfer hilton icon jerky |; @unique = $lcu->get_unique; $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcu->get_unique_ref; $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @unique = $lcu->get_Lonly; $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcu->get_Lonly_ref; $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @unique = $lcu->get_Aonly; $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcu->get_Aonly_ref; $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ 'abel' ], [ 'hilton' ], ); $unique_all_ref = $lcu->get_unique_all(); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_unique_all()"); %pred = map {$_, 1} qw( hilton ); @unpred = qw| abel baker camera delta edward fargo golfer icon jerky |; @complement = $lcu->get_complement; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcu->get_complement_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @complement = $lcu->get_Ronly; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcu->get_Ronly_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @complement = $lcu->get_Bonly; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcu->get_Bonly_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ qw( hilton ) ], [ qw( abel ) ], ); $complement_all_ref = $lcu->get_complement_all(); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %pred = map {$_, 1} qw( abel hilton ); @unpred = qw| baker camera delta edward fargo golfer icon jerky |; @symmetric_difference = $lcu->get_symmetric_difference; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_symmetric_difference_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcu->get_symdiff; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_symdiff_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcu->get_LorRonly; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_LorRonly_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcu->get_AorBonly; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_AorBonly_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel hilton ); @unpred = qw| baker camera delta edward fargo golfer icon jerky |; { my ($rv, $stdout, $stderr); capture( sub { @nonintersection = $lcu->get_nonintersection; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@nonintersection); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); { my ($rv, $stdout, $stderr); capture( sub { $nonintersection_ref = $lcu->get_nonintersection_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$nonintersection_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); %pred = ( abel => 2, baker => 2, camera => 2, delta => 3, edward => 2, fargo => 2, golfer => 2, hilton => 1, ); @unpred = qw| icon jerky |; @bag = $lcu->get_bag; $seen{$_}++ foreach (@bag); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $bag_ref = $lcu->get_bag_ref; $seen{$_}++ foreach (@{$bag_ref}); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $LR = $lcu->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); $LR = $lcu->is_AsubsetB; ok(! $LR, "Got expected subset relationship"); $RL = $lcu->is_RsubsetL; ok(! $RL, "Got expected subset relationship"); $RL = $lcu->is_BsubsetA; ok(! $RL, "Got expected subset relationship"); $eqv = $lcu->is_LequivalentR; ok(! $eqv, "Got expected equivalent relationship"); $eqv = $lcu->is_LeqvlntR; ok(! $eqv, "Got expected equivalent relationship"); $disj = $lcu->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcu->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcu->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } ok(wrap_is_member_which( $lcu, $test_members_which, ), "is_member_which() returned all expected values"); ok(wrap_is_member_which_ref( $lcu, $test_members_which, ), "is_member_which_ref() returned all expected values"); @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); $memb_hash_ref = $lcu->are_members_which( \@args ); ok(wrap_are_members_which( $memb_hash_ref, $test_members_which, ), "are_members_which() returned all expected value"); ok(wrap_is_member_any( $lcu, $test_members_any, ), "is_member_any() returned all expected values"); $memb_hash_ref = $lcu->are_members_any( \@args ); ok(wrap_are_members_any( $memb_hash_ref, $test_members_any, ), "are_members_any() returned all expected values"); $vers = $lcu->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lcu_s = List::Compare->new('-u', '-a', \@a2, \@a3); ok($lcu_s, "constructor returned true value"); $LR = $lcu_s->is_LsubsetR; ok(! $LR, "non-subset correctly determined"); $LR = $lcu_s->is_AsubsetB; ok(! $LR, "non-subset correctly determined"); $RL = $lcu_s->is_RsubsetL; ok($RL, "subset correctly determined"); $RL = $lcu_s->is_BsubsetA; ok($RL, "subset correctly determined"); $eqv = $lcu_s->is_LequivalentR; ok(! $eqv, "non-equivalence correctly determined"); $eqv = $lcu_s->is_LeqvlntR; ok(! $eqv, "non-equivalence correctly determined"); $disj = $lcu_s->is_LdisjointR; ok(! $disj, "non-disjoint correctly determined"); ### new ### my $lcu_e = List::Compare->new('-u', '-a', \@a3, \@a4); ok($lcu_e, "constructor returned true value"); $eqv = $lcu_e->is_LequivalentR; ok($eqv, "Got expected equivalent relationship"); $eqv = $lcu_e->is_LeqvlntR; ok($eqv, "Got expected equivalent relationship"); $disj = $lcu_e->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); ### new ### my $lcu_dj = List::Compare->new('-u', \@a4, \@a8); ok($lcu_dj, "constructor returned true value"); ok(0 == $lcu_dj->get_intersection, "no intersection, as expected"); ok(0 == scalar(@{$lcu_dj->get_intersection_ref}), "no intersection, as expected"); $disj = $lcu_dj->is_LdisjointR; ok($disj, "disjoint correctly determined"); ########## BELOW: Tests for '--unsorted' and '--accelerated' options ########## my $lcaun = List::Compare->new('--unsorted', '-a', \@a0, \@a1); ok($lcaun, "Constructor worked with --unsorted and -a options"); my $lcaun_s = List::Compare->new('--unsorted', '-a', \@a2, \@a3); ok($lcaun_s, "Constructor worked with --unsorted and -a options"); my $lcaun_e = List::Compare->new('--unsorted', '-a', \@a3, \@a4); ok($lcaun_e, "Constructor worked with --unsorted and -a options"); my $lcaccun = List::Compare->new('--unsorted', '--accelerated', \@a0, \@a1); ok($lcaccun, "Constructor worked with --unsorted and --accelerated options"); my $lcaccun_s = List::Compare->new('--unsorted', '--accelerated', \@a2, \@a3); ok($lcaccun_s, "Constructor worked with --unsorted and --accelerated options"); my $lcaccun_e = List::Compare->new('--unsorted', '--accelerated', \@a3, \@a4); ok($lcaccun_e, "Constructor worked with --unsorted and --accelerated options"); my $lcaccu = List::Compare->new('-u', '--accelerated', \@a0, \@a1); ok($lcaccu, "Constructor worked with -u and --accelerated options"); my $lcaccu_s = List::Compare->new('-u', '--accelerated', \@a2, \@a3); ok($lcaccu_s, "Constructor worked with -u and --accelerated options"); my $lcaccu_e = List::Compare->new('-u', '--accelerated', \@a3, \@a4); ok($lcaccu_e, "Constructor worked with -u and --accelerated options"); List-Compare-0.53/t/03_oo_lists_dual_acc_sorted.t0000755000175000017500000002721612465263760021556 0ustar jkeenanjkeenan# perl #$Id$ # 03_oo_lists_dual_acc_sorted.t use strict; use Test::More tests => 86; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :arrays :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; ### new ### my $lc = List::Compare->new('-a', \@a0, \@a1); ok($lc, "List::Compare constructor returned true value"); @pred = qw(abel baker camera delta edward fargo golfer hilton); @union = $lc->get_union; is_deeply( \@union, \@pred, "Got expected union"); $union_ref = $lc->get_union_ref; is_deeply( $union_ref, \@pred, "Got expected union"); { my ($rv, $stdout, $stderr); capture( sub { @shared = $lc->get_shared; }, \$stdout, \$stderr, ); is_deeply( \@shared, \@pred, "Got expected shared"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } { my ($rv, $stdout, $stderr); capture( sub { $shared_ref = $lc->get_shared_ref; }, \$stdout, \$stderr, ); is_deeply( $shared_ref, \@pred, "Got expected shared"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } @pred = qw( baker camera delta edward fargo golfer ); @intersection = $lc->get_intersection; is_deeply(\@intersection, \@pred, "Got expected intersection"); $intersection_ref = $lc->get_intersection_ref; is_deeply($intersection_ref, \@pred, "Got expected intersection"); @pred = qw( abel ); @unique = $lc->get_unique; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lc->get_unique_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); @unique = $lc->get_Lonly; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lc->get_Lonly_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); @unique = $lc->get_Aonly; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lc->get_Aonly_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); @pred = ( [ 'abel' ], [ 'hilton' ], ); $unique_all_ref = $lc->get_unique_all(); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_unique_all()"); @pred = qw ( hilton ); @complement = $lc->get_complement; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lc->get_complement_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); @complement = $lc->get_Ronly; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lc->get_Ronly_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); @complement = $lc->get_Bonly; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lc->get_Bonly_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); @pred = ( [ qw( hilton ) ], [ qw( abel ) ], ); $complement_all_ref = $lc->get_complement_all(); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); @pred = qw( abel hilton ); @symmetric_difference = $lc->get_symmetric_difference; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_symmetric_difference_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lc->get_symdiff; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_symdiff_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lc->get_LorRonly; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_LorRonly_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lc->get_AorBonly; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_AorBonly_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @pred = qw( abel hilton ); { my ($rv, $stdout, $stderr); capture( sub { @nonintersection = $lc->get_nonintersection; }, \$stdout, \$stderr, ); is_deeply( \@nonintersection, \@pred, "Got expected nonintersection"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } { my ($rv, $stdout, $stderr); capture( sub { $nonintersection_ref = $lc->get_nonintersection_ref; }, \$stdout, \$stderr, ); is_deeply($nonintersection_ref, \@pred, "Got expected nonintersection"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } @pred = qw( abel abel baker baker camera camera delta delta delta edward edward fargo fargo golfer golfer hilton ); @bag = $lc->get_bag; is_deeply(\@bag, \@pred, "Got expected bag"); $bag_ref = $lc->get_bag_ref; is_deeply($bag_ref, \@pred, "Got expected bag"); $LR = $lc->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); $LR = $lc->is_AsubsetB; ok(! $LR, "Got expected subset relationship"); $RL = $lc->is_RsubsetL; ok(! $RL, "Got expected subset relationship"); $RL = $lc->is_BsubsetA; ok(! $RL, "Got expected subset relationship"); $eqv = $lc->is_LequivalentR; ok(! $eqv, "Got expected equivalent relationship"); $eqv = $lc->is_LeqvlntR; ok(! $eqv, "Got expected equivalent relationship"); $disj = $lc->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lc->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lc->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } ok(wrap_is_member_which( $lc, $test_members_which, ), "is_member_which() returned all expected values"); eval { $memb_arr_ref = $lc->is_member_which('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which() correctly generated error message"); ok(wrap_is_member_which_ref( $lc, $test_members_which, ), "is_member_which_ref() returned all expected values"); eval { $memb_arr_ref = $lc->is_member_which_ref('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which_ref() correctly generated error message"); eval { $memb_arr_ref = $lc->is_member_which_ref( [ 'jerky' ] ) }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which_ref() correctly generated error message"); @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); $memb_hash_ref = $lc->are_members_which( \@args ); ok(wrap_are_members_which( $memb_hash_ref, $test_members_which, ), "are_members_which() returned all expected value"); eval { $memb_hash_ref = $lc->are_members_which( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_which() correctly generated error message"); eval { $memb_hash_ref = $lc->are_members_which( \@args, [ 1 .. 3 ] ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_which() correctly generated error message"); ok(wrap_is_member_any( $lc, $test_members_any, ), "is_member_any() returned all expected values"); eval { $lc->is_member_any('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_any() correctly generated error message"); eval { $lc->is_member_any( [ 'jerky' ] ) }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_any() correctly generated error message"); $memb_hash_ref = $lc->are_members_any( \@args ); ok(wrap_are_members_any( $memb_hash_ref, $test_members_any, ), "are_members_any() returned all expected values"); eval { $memb_hash_ref = $lc->are_members_any( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_any() correctly generated error message"); eval { $memb_hash_ref = $lc->are_members_any( \@args, [ 1..3 ] ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_any() correctly generated error message"); $vers = $lc->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lc_s = List::Compare->new('-a', \@a2, \@a3); ok($lc_s, "constructor returned true value"); $LR = $lc_s->is_LsubsetR; ok(! $LR, "non-subset correctly determined"); $LR = $lc_s->is_AsubsetB; ok(! $LR, "non-subset correctly determined"); $RL = $lc_s->is_RsubsetL; ok($RL, "subset correctly determined"); $RL = $lc_s->is_BsubsetA; ok($RL, "subset correctly determined"); $eqv = $lc_s->is_LequivalentR; ok(! $eqv, "non-equivalence correctly determined"); $eqv = $lc_s->is_LeqvlntR; ok(! $eqv, "non-equivalence correctly determined"); $disj = $lc_s->is_LdisjointR; ok(! $disj, "non-disjoint correctly determined"); ### new ### my $lc_e = List::Compare->new('-a', \@a3, \@a4); ok($lc_e, "constructor returned true value"); $eqv = $lc_e->is_LequivalentR; ok($eqv, "equivalence correctly determined"); $eqv = $lc_e->is_LeqvlntR; ok($eqv, "equivalence correctly determined"); $disj = $lc_e->is_LdisjointR; ok(! $disj, "non-disjoint correctly determined"); ### new ### my $lc_dj = List::Compare->new('-a', \@a4, \@a8); ok($lc_dj, "constructor returned true value"); ok(0 == $lc_dj->get_intersection, "no intersection, as expected"); ok(0 == scalar(@{$lc_dj->get_intersection_ref}), "no intersection, as expected"); $disj = $lc_dj->is_LdisjointR; ok($disj, "disjoint correctly determined"); ########## BELOW: Tests for '--accelerated' option ########## my $lcacc = List::Compare->new('--accelerated', \@a0, \@a1); ok($lcacc, "Constructor worked with --accelerated option"); my $lcacc_s = List::Compare->new('--accelerated', \@a2, \@a3); ok($lcacc_s, "Constructor worked with --accelerated option"); my $lcacc_e = List::Compare->new('--accelerated', \@a3, \@a4); ok($lcacc_e, "Constructor worked with --accelerated option"); ########## BELOW: Test for bad arguments to constructor ########## my ($lc_bad); my %h5 = ( golfer => 1, lambda => 0, ); eval { $lc_bad = List::Compare->new('-a', \@a0, \%h5) }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); eval { $lc_bad = List::Compare->new('-a', \%h5, \@a0) }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); my $scalar = 'test'; eval { $lc_bad = List::Compare->new('-a', \$scalar, \@a0) }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); eval { $lc_bad = List::Compare->new('-a', \@a0) }; like($@, qr/Must pass at least 2 references/, "Got expected error message from bad constructor"); List-Compare-0.53/t/09_oo_lists_alt_dual_reg_sorted.t0000755000175000017500000002474312465263760022455 0ustar jkeenanjkeenan# perl #$Id$ # 09_oo_lists_alt_dual_reg_sorted.t use strict; use Test::More tests => 79; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :arrays :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref); ### new ### my $lc = List::Compare->new( { lists => [ \@a0, \@a1 ] } ); ok($lc, "List::Compare constructor returned true value"); @pred = qw(abel baker camera delta edward fargo golfer hilton); @union = $lc->get_union; is_deeply( \@union, \@pred, "Got expected union"); $union_ref = $lc->get_union_ref; is_deeply( $union_ref, \@pred, "Got expected union"); @pred = qw( baker camera delta edward fargo golfer ); @intersection = $lc->get_intersection; is_deeply(\@intersection, \@pred, "Got expected intersection"); $intersection_ref = $lc->get_intersection_ref; is_deeply($intersection_ref, \@pred, "Got expected intersection"); { my ($rv, $stdout, $stderr); capture( sub { @shared = $lc->get_shared; }, \$stdout, \$stderr, ); is_deeply( \@shared, \@pred, "Got expected shared"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } { my ($rv, $stdout, $stderr); capture( sub { $shared_ref = $lc->get_shared_ref; }, \$stdout, \$stderr, ); is_deeply( $shared_ref, \@pred, "Got expected shared"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } @pred = qw( abel ); @unique = $lc->get_unique; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lc->get_unique_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); @unique = $lc->get_Lonly; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lc->get_Lonly_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); @unique = $lc->get_Aonly; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lc->get_Aonly_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); @pred = ( [ 'abel' ], [ 'hilton' ], ); $unique_all_ref = $lc->get_unique_all(); is_deeply($unique_all_ref, [ @pred ], "Got expected values for get_unique_all()"); @pred = qw ( hilton ); @complement = $lc->get_complement; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lc->get_complement_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); @complement = $lc->get_Ronly; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lc->get_Ronly_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); @complement = $lc->get_Bonly; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lc->get_Bonly_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); @pred = ( [ qw( hilton ) ], [ qw( abel ) ], ); $complement_all_ref = $lc->get_complement_all(); is_deeply($complement_all_ref, [ @pred ], "Got expected values for get_complement_all()"); @pred = qw( abel hilton ); @symmetric_difference = $lc->get_symmetric_difference; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_symmetric_difference_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lc->get_symdiff; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_symdiff_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lc->get_LorRonly; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_LorRonly_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lc->get_AorBonly; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_AorBonly_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @pred = qw( abel hilton ); { my ($rv, $stdout, $stderr); capture( sub { @nonintersection = $lc->get_nonintersection; }, \$stdout, \$stderr, ); is_deeply( \@nonintersection, \@pred, "Got expected nonintersection"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } { my ($rv, $stdout, $stderr); capture( sub { $nonintersection_ref = $lc->get_nonintersection_ref; }, \$stdout, \$stderr, ); is_deeply($nonintersection_ref, \@pred, "Got expected nonintersection"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } @pred = qw( abel abel baker baker camera camera delta delta delta edward edward fargo fargo golfer golfer hilton ); @bag = $lc->get_bag; is_deeply(\@bag, \@pred, "Got expected bag"); $bag_ref = $lc->get_bag_ref; is_deeply($bag_ref, \@pred, "Got expected bag"); $LR = $lc->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); $LR = $lc->is_AsubsetB; ok(! $LR, "Got expected subset relationship"); $RL = $lc->is_RsubsetL; ok(! $RL, "Got expected subset relationship"); $RL = $lc->is_BsubsetA; ok(! $RL, "Got expected subset relationship"); $eqv = $lc->is_LequivalentR; ok(! $eqv, "Got expected equivalent relationship"); $eqv = $lc->is_LeqvlntR; ok(! $eqv, "Got expected equivalent relationship"); $disj = $lc->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lc->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lc->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } ok(wrap_is_member_which( $lc, $test_members_which, ), "is_member_which() returned all expected values"); eval { $memb_arr_ref = $lc->is_member_which('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which() correctly generated error message"); ok(wrap_is_member_which_ref( $lc, $test_members_which, ), "is_member_which_ref() returned all expected values"); eval { $memb_arr_ref = $lc->is_member_which_ref('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which_ref() correctly generated error message"); $memb_hash_ref = $lc->are_members_which( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); ok(wrap_are_members_which( $memb_hash_ref, $test_members_which, ), "are_members_which() returned all expected value"); eval { $memb_hash_ref = $lc->are_members_which( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_which() correctly generated error message"); ok(wrap_is_member_any( $lc, $test_members_any, ), "is_member_any() returned all expected values"); eval { $lc->is_member_any('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_any() correctly generated error message"); $memb_hash_ref = $lc->are_members_any( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); ok(wrap_are_members_any( $memb_hash_ref, $test_members_any, ), "are_members_any() returned all expected values"); eval { $memb_hash_ref = $lc->are_members_any( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_any() correctly generated error message"); $vers = $lc->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lc_s = List::Compare->new( { lists => [ \@a2, \@a3 ] } ); ok($lc_s, "constructor returned true value"); $LR = $lc_s->is_LsubsetR; ok(! $LR, "non-subset correctly determined"); $LR = $lc_s->is_AsubsetB; ok(! $LR, "non-subset correctly determined"); $RL = $lc_s->is_RsubsetL; ok($RL, "subset correctly determined"); $RL = $lc_s->is_BsubsetA; ok($RL, "subset correctly determined"); $eqv = $lc_s->is_LequivalentR; ok(! $eqv, "non-equivalence correctly determined"); $eqv = $lc_s->is_LeqvlntR; ok(! $eqv, "non-equivalence correctly determined"); $disj = $lc_s->is_LdisjointR; ok(! $disj, "non-disjoint correctly determined"); ### new ### my $lc_e = List::Compare->new( { lists => [ \@a3, \@a4 ] } ); ok($lc_e, "constructor returned true value"); $eqv = $lc_e->is_LequivalentR; ok($eqv, "equivalence correctly determined"); $eqv = $lc_e->is_LeqvlntR; ok($eqv, "equivalence correctly determined"); $disj = $lc_e->is_LdisjointR; ok(! $disj, "non-disjoint correctly determined"); ### new ### my $lc_dj = List::Compare->new( { lists => [ \@a4, \@a8 ] } ); ok($lc_dj, "constructor returned true value"); ok(0 == $lc_dj->get_intersection, "no intersection, as expected"); ok(0 == scalar(@{$lc_dj->get_intersection_ref}), "no intersection, as expected"); $disj = $lc_dj->is_LdisjointR; ok($disj, "disjoint correctly determined"); ########## BELOW: Test for bad arguments to constructor ########## my ($lc_bad); my %h5 = ( golfer => 1, lambda => 0, ); eval { $lc_bad = List::Compare->new( { lists => [ \@a0, \%h5 ] } ) }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); eval { $lc_bad = List::Compare->new( { lists => [ \%h5, \@a0 ] } ) }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); my $scalar = 'test'; eval { $lc_bad = List::Compare->new( { lists => [ \$scalar, \@a0 ] } ) }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); eval { $lc_bad = List::Compare->new( { lists => [ \@a0 ] } ) }; like($@, qr/Must pass at least 2 references/, "Got expected error message from bad constructor"); List-Compare-0.53/t/31_oo_hashes_alt_mult_acc_sorted.t0000755000175000017500000004154612465263760022572 0ustar jkeenanjkeenan# perl #$Id$ # 31_oo_hashes_alt_mult_acc_sorted.t use strict; use Test::More tests => 104; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :hashes :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; ### new ### my $lcm = List::Compare->new( { accelerated => 1, lists => [ \%h0, \%h1, \%h2, \%h3, \%h4 ], } ); ok($lcm, "List::Compare constructor returned true value"); @pred = qw(abel baker camera delta edward fargo golfer hilton icon jerky); @union = $lcm->get_union; is_deeply( \@union, \@pred, "Got expected union"); $union_ref = $lcm->get_union_ref; is_deeply( $union_ref, \@pred, "Got expected union"); @pred = qw(baker camera delta edward fargo golfer hilton icon); @shared = $lcm->get_shared; is_deeply( \@shared, \@pred, "Got expected shared"); $shared_ref = $lcm->get_shared_ref; is_deeply( $shared_ref, \@pred, "Got expected shared"); @pred = qw(fargo golfer); @intersection = $lcm->get_intersection; is_deeply(\@intersection, \@pred, "Got expected intersection"); $intersection_ref = $lcm->get_intersection_ref; is_deeply($intersection_ref, \@pred, "Got expected intersection"); @pred = qw( jerky ); @unique = $lcm->get_unique(2); is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lcm->get_unique_ref(2); is_deeply($unique_ref, \@pred, "Got expected unique"); eval { $unique_ref = $lcm->get_unique_ref('jerky') }; like($@, qr/Argument to method List::Compare::Multiple::Accelerated::get_unique_ref must be the array index/, "Got expected error message" ); { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Lonly(2); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Lonly_ref(2); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Aonly(2); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Aonly_ref(2); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } @pred = qw( abel ); @unique = $lcm->get_unique; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lcm->get_unique_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Lonly(); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Lonly_ref(); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @unique = $lcm->get_Aonly(); }, \$stdout, \$stderr, ); is_deeply(\@unique, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $unique_ref = $lcm->get_Aonly_ref(); }, \$stdout, \$stderr, ); is_deeply($unique_ref, \@pred, "Got expected unique"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning", ); } @pred = ( [ 'abel' ], [ ], [ 'jerky' ], [ ], [ ], ); $unique_all_ref = $lcm->get_unique_all(); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_unique_all()"); @pred = qw( abel icon jerky ); @complement = $lcm->get_complement(1); is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lcm->get_complement_ref(1); is_deeply($complement_ref, \@pred, "Got expected complement"); eval { $complement_ref = $lcm->get_complement_ref('jerky') }; like($@, qr/Argument to method List::Compare::Multiple::Accelerated::get_complement_ref must be the array index/, "Got expected error message" ); { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Ronly(1); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Ronly_ref(1); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Bonly(1); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Bonly_ref(1); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } @pred = qw ( hilton icon jerky ); @complement = $lcm->get_complement; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lcm->get_complement_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Ronly(); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Ronly_ref(); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @complement = $lcm->get_Bonly(); }, \$stdout, \$stderr, ); is_deeply(\@complement, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $complement_ref = $lcm->get_Bonly_ref(); }, \$stdout, \$stderr, ); is_deeply($complement_ref, \@pred, "Got expected complement"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning", ); } @pred = qw( abel jerky ); @symmetric_difference = $lcm->get_symmetric_difference; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lcm->get_symmetric_difference_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lcm->get_symdiff; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lcm->get_symdiff_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); { my ($rv, $stdout, $stderr); capture( sub { @symmetric_difference = $lcm->get_LorRonly; }, \$stdout, \$stderr, ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcm->get_LorRonly_ref; }, \$stdout, \$stderr, ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly_ref or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { @symmetric_difference = $lcm->get_AorBonly; }, \$stdout, \$stderr, ); is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcm->get_AorBonly_ref; }, \$stdout, \$stderr, ); is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly_ref or its alias defaults/, "Got expected warning", ); } %seen = (); @pred = ( [ qw( hilton icon jerky ) ], [ qw( abel icon jerky ) ], [ qw( abel baker camera delta edward ) ], [ qw( abel baker camera delta edward jerky ) ], [ qw( abel baker camera delta edward jerky ) ], ); $complement_all_ref = $lcm->get_complement_all(); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); @pred = qw( abel baker camera delta edward hilton icon jerky ); @nonintersection = $lcm->get_nonintersection; is_deeply( \@nonintersection, \@pred, "Got expected nonintersection"); $nonintersection_ref = $lcm->get_nonintersection_ref; is_deeply($nonintersection_ref, \@pred, "Got expected nonintersection"); @pred = qw( abel abel baker baker camera camera delta delta delta edward edward fargo fargo fargo fargo fargo fargo golfer golfer golfer golfer golfer hilton hilton hilton hilton icon icon icon icon icon jerky ); @bag = $lcm->get_bag; is_deeply(\@bag, \@pred, "Got expected bag"); $bag_ref = $lcm->get_bag_ref; is_deeply($bag_ref, \@pred, "Got expected bag"); $LR = $lcm->is_LsubsetR(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcm->is_AsubsetB(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcm->is_LsubsetR(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcm->is_AsubsetB(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcm->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); eval { $LR = $lcm->is_LsubsetR(2) }; like($@, qr/Method.*?requires 2 arguments/, "Got expected error message" ); eval { $LR = $lcm->is_LsubsetR(8,9) }; like($@, qr/Each argument to method.*?must be a valid array index /, "Got expected error message" ); { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcm->is_RsubsetL; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcm->is_BsubsetA; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } $eqv = $lcm->is_LequivalentR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcm->is_LeqvlntR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcm->is_LequivalentR(2,4); ok(! $eqv, "Got expected equivalence relationship"); eval { $eqv = $lcm->is_LequivalentR(2) }; like($@, qr/Method List::Compare::Multiple::Accelerated::is_LequivalentR requires 2 arguments/, "Got expected error message", ); eval { $eqv = $lcm->is_LequivalentR(8,9) }; like($@, qr/Each argument to method List::Compare::Multiple::Accelerated::is_LequivalentR must be a valid array index/, "Got expected error message", ); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcm->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcm->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); is_deeply( all_is_member_which( $lcm, \@args), $test_member_which_mult, "is_member_which() returned all expected values"); eval { $memb_arr_ref = $lcm->is_member_which('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which() correctly generated error message"); is_deeply( all_is_member_which_ref( $lcm, \@args), $test_member_which_mult, "is_member_which_ref() returned all expected values"); eval { $memb_arr_ref = $lcm->is_member_which_ref('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which_ref() correctly generated error message"); $memb_hash_ref = $lcm->are_members_which( \@args ); is_deeply($memb_hash_ref, $test_members_which_mult, "are_members_which() returned all expected values"); eval { $memb_hash_ref = $lcm->are_members_which( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_which() correctly generated error message"); is_deeply( all_is_member_any( $lcm, \@args), $test_member_any_mult, "is_member_which() returned all expected values"); eval { $lcm->is_member_any('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_any() correctly generated error message"); $memb_hash_ref = $lcm->are_members_any( \@args ); ok(wrap_are_members_any( $memb_hash_ref, $test_members_any_mult, ), "are_members_any() returned all expected values"); eval { $memb_hash_ref = $lcm->are_members_any( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_any() correctly generated error message"); $vers = $lcm->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lcm_dj = List::Compare->new( { accelerated => 1, lists => [ \%h0, \%h1, \%h2, \%h3, \%h4, \%h8 ], } ); ok($lcm_dj, "Constructor returned true value"); $disj = $lcm_dj->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); $disj = $lcm_dj->is_LdisjointR(2,3); ok(! $disj, "Got expected disjoint relationship"); $disj = $lcm_dj->is_LdisjointR(4,5); ok($disj, "Got expected disjoint relationship"); eval { $disj = $lcm_dj->is_LdisjointR(2) }; like($@, qr/Method List::Compare::Multiple::Accelerated::is_LdisjointR requires 2 arguments/, "Got expected error message"); ########## BELOW: Testfor bad arguments to constructor ########## my ($lcm_bad); my $scalar = 'test'; eval { $lcm_bad = List::Compare->new( { accelerated => 1, lists => [ \$scalar, \%h0, \%h1 ], } ); }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); List-Compare-0.53/t/11_oo_lists_alt_dual_acc_sorted.t0000755000175000017500000002545112465263760022414 0ustar jkeenanjkeenan# perl #$Id$ # 11_oo_lists_alt_dual_acc_sorted.t use strict; use Test::More tests => 79; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :arrays :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); ### new ### my $lc = List::Compare->new( { accelerated => 1, lists => [ \@a0, \@a1 ], } ); ok($lc, "List::Compare constructor returned true value"); @pred = qw(abel baker camera delta edward fargo golfer hilton); @union = $lc->get_union; is_deeply( \@union, \@pred, "Got expected union"); $union_ref = $lc->get_union_ref; is_deeply( $union_ref, \@pred, "Got expected union"); { my ($rv, $stdout, $stderr); capture( sub { @shared = $lc->get_shared; }, \$stdout, \$stderr, ); is_deeply( \@shared, \@pred, "Got expected shared"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } { my ($rv, $stdout, $stderr); capture( sub { $shared_ref = $lc->get_shared_ref; }, \$stdout, \$stderr, ); is_deeply( $shared_ref, \@pred, "Got expected shared"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } @pred = qw( baker camera delta edward fargo golfer ); @intersection = $lc->get_intersection; is_deeply(\@intersection, \@pred, "Got expected intersection"); $intersection_ref = $lc->get_intersection_ref; is_deeply($intersection_ref, \@pred, "Got expected intersection"); @pred = qw( abel ); @unique = $lc->get_unique; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lc->get_unique_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); @unique = $lc->get_Lonly; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lc->get_Lonly_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); @unique = $lc->get_Aonly; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lc->get_Aonly_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); @pred = ( [ 'abel' ], [ 'hilton' ], ); $unique_all_ref = $lc->get_unique_all(); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_unique_all()"); @pred = qw ( hilton ); @complement = $lc->get_complement; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lc->get_complement_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); @complement = $lc->get_Ronly; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lc->get_Ronly_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); @complement = $lc->get_Bonly; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lc->get_Bonly_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); @pred = ( [ qw( hilton ) ], [ qw( abel ) ], ); $complement_all_ref = $lc->get_complement_all(); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); @pred = qw( abel hilton ); @symmetric_difference = $lc->get_symmetric_difference; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_symmetric_difference_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lc->get_symdiff; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_symdiff_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lc->get_LorRonly; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_LorRonly_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lc->get_AorBonly; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_AorBonly_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @pred = qw( abel hilton ); { my ($rv, $stdout, $stderr); capture( sub { @nonintersection = $lc->get_nonintersection; }, \$stdout, \$stderr, ); is_deeply( \@nonintersection, \@pred, "Got expected nonintersection"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } { my ($rv, $stdout, $stderr); capture( sub { $nonintersection_ref = $lc->get_nonintersection_ref; }, \$stdout, \$stderr, ); is_deeply($nonintersection_ref, \@pred, "Got expected nonintersection"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } @pred = qw( abel abel baker baker camera camera delta delta delta edward edward fargo fargo golfer golfer hilton ); @bag = $lc->get_bag; is_deeply(\@bag, \@pred, "Got expected bag"); $bag_ref = $lc->get_bag_ref; is_deeply($bag_ref, \@pred, "Got expected bag"); $LR = $lc->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); $LR = $lc->is_AsubsetB; ok(! $LR, "Got expected subset relationship"); $RL = $lc->is_RsubsetL; ok(! $RL, "Got expected subset relationship"); $RL = $lc->is_BsubsetA; ok(! $RL, "Got expected subset relationship"); $eqv = $lc->is_LequivalentR; ok(! $eqv, "Got expected equivalent relationship"); $eqv = $lc->is_LeqvlntR; ok(! $eqv, "Got expected equivalent relationship"); $disj = $lc->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lc->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lc->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } ok(wrap_is_member_which( $lc, $test_members_which, ), "is_member_which() returned all expected values"); eval { $memb_arr_ref = $lc->is_member_which('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which() correctly generated error message"); ok(wrap_is_member_which_ref( $lc, $test_members_which, ), "is_member_which_ref() returned all expected values"); eval { $memb_arr_ref = $lc->is_member_which_ref('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which_ref() correctly generated error message"); $memb_hash_ref = $lc->are_members_which( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); ok(wrap_are_members_which( $memb_hash_ref, $test_members_which, ), "are_members_which() returned all expected value"); eval { $memb_hash_ref = $lc->are_members_which( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_which() correctly generated error message"); ok(wrap_is_member_any( $lc, $test_members_any, ), "is_member_any() returned all expected values"); eval { $lc->is_member_any('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_any() correctly generated error message"); $memb_hash_ref = $lc->are_members_any( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); ok(wrap_are_members_any( $memb_hash_ref, $test_members_any, ), "are_members_any() returned all expected values"); eval { $memb_hash_ref = $lc->are_members_any( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_any() correctly generated error message"); $vers = $lc->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lc_s = List::Compare->new( { accelerated => 1, lists => [ \@a2, \@a3 ], } ); ok($lc_s, "constructor returned true value"); $LR = $lc_s->is_LsubsetR; ok(! $LR, "non-subset correctly determined"); $LR = $lc_s->is_AsubsetB; ok(! $LR, "non-subset correctly determined"); $RL = $lc_s->is_RsubsetL; ok($RL, "subset correctly determined"); $RL = $lc_s->is_BsubsetA; ok($RL, "subset correctly determined"); $eqv = $lc_s->is_LequivalentR; ok(! $eqv, "non-equivalence correctly determined"); $eqv = $lc_s->is_LeqvlntR; ok(! $eqv, "non-equivalence correctly determined"); $disj = $lc_s->is_LdisjointR; ok(! $disj, "non-disjoint correctly determined"); ### new ### my $lc_e = List::Compare->new( { accelerated => 1, lists => [ \@a3, \@a4 ], } ); ok($lc_e, "constructor returned true value"); $eqv = $lc_e->is_LequivalentR; ok($eqv, "equivalence correctly determined"); $eqv = $lc_e->is_LeqvlntR; ok($eqv, "equivalence correctly determined"); $disj = $lc_e->is_LdisjointR; ok(! $disj, "non-disjoint correctly determined"); ### new ### my $lc_dj = List::Compare->new( { accelerated => 1, lists => [ \@a4, \@a8 ], } ); ok($lc_dj, "constructor returned true value"); ok(0 == $lc_dj->get_intersection, "no intersection, as expected"); ok(0 == scalar(@{$lc_dj->get_intersection_ref}), "no intersection, as expected"); $disj = $lc_dj->is_LdisjointR; ok($disj, "disjoint correctly determined"); ########## BELOW: Test for bad arguments to constructor ########## my ($lc_bad); my %h5 = ( golfer => 1, lambda => 0, ); eval { $lc_bad = List::Compare->new( { accelerated => 1, lists => [ \@a0, \%h5 ], } ); }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); eval { $lc_bad = List::Compare->new( { accelerated => 1, lists => [ \%h5, \@a0 ], } ) }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); my $scalar = 'test'; eval { $lc_bad = List::Compare->new( { accelerated => 1, lists => [ \$scalar, \@a0 ], } ) }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); eval { $lc_bad = List::Compare->new( { accelerated => 1, lists => [ \@a0 ], } ) }; like($@, qr/Must pass at least 2 references/, "Got expected error message from bad constructor"); List-Compare-0.53/t/50_lcf_subset.t0000755000175000017500000000606212535072055016650 0ustar jkeenanjkeenan# perl #$Id$ # 50_lcf_subset.t use strict; use Test::More tests => 28; use List::Compare::Functional qw(is_LsubsetR is_RsubsetL); my @a0 = ( qw| alpha | ); my @a1 = ( qw| alpha beta | ); my @a2 = ( qw| alpha beta gamma | ); my @a3 = ( qw| gamma | ); my ($LR, $RL); $LR = is_LsubsetR( [ [], [] ] ); ok($LR, "simple: empty array is subset of itself"); $RL = is_RsubsetL( [ [], [] ] ); ok($RL, "simple: empty array is subset of itself"); $LR = is_LsubsetR( [ \@a0, \@a0 ] ); ok($LR, "simple: array is subset of itself"); $RL = is_RsubsetL( [ \@a0, \@a0 ] ); ok($RL, "simple: array is subset of itself"); $LR = is_LsubsetR( [ \@a0, \@a3 ] ); ok(! $LR, "simple: disjoint are not subsets"); $RL = is_RsubsetL( [ \@a0, \@a3 ] ); ok(! $RL, "simple: disjoint are not subsets"); $LR = is_LsubsetR( [ \@a0, \@a1 ] ); ok($LR, "simple: left is subset of right"); $RL = is_RsubsetL( [ \@a0, \@a1 ] ); ok(! $RL, "simple: right is not subset of left"); $LR = is_LsubsetR( [ \@a1, \@a0 ] ); ok(! $LR, "simple: left is not subset of right"); $RL = is_RsubsetL( [ \@a1, \@a0 ] ); ok($RL, "right is subset of left"); $LR = is_LsubsetR( { lists => [ [], [] ] } ); ok($LR, "hashref lists: empty array is subset of itself"); $RL = is_RsubsetL( { lists => [ [], [] ] } ); ok($LR, "hashref lists: empty array is subset of itself"); $LR = is_LsubsetR( { lists => [ \@a0, \@a0 ] } ); ok($LR, "hashref lists: array is subset of itself"); $RL = is_RsubsetL( { lists => [ \@a0, \@a0 ] } ); ok($RL, "hashref lists: array is subset of itself"); $LR = is_LsubsetR( { lists => [ \@a0, \@a3 ] } ); ok(! $LR, "hashref lists: disjoint are not subsets"); $RL = is_RsubsetL( { lists => [ \@a0, \@a3 ] } ); ok(! $RL, "hashref lists: disjoint are not subsets"); $LR = is_LsubsetR( { lists => [ \@a0, \@a1 ] } ); ok($LR, "hashref lists: left is subset of right"); $RL = is_RsubsetL( { lists => [ \@a0, \@a1 ] } ); ok(! $RL, "hashref lists: right is not subset of left"); $LR = is_LsubsetR( { lists => [ \@a1, \@a0 ] } ); ok(! $LR, "hashref lists: left is not subset of right"); $RL = is_RsubsetL( { lists => [ \@a1, \@a0 ] } ); ok($RL, "right is subset of left"); $LR = is_LsubsetR( [ \@a0, \@a1 ], [ 0,1 ] ); ok($LR, "2 indices arrayref: left is subset of right"); $LR = is_LsubsetR( [ \@a1, \@a0 ], [ 0,1 ] ); ok(! $LR, "2 indices arrayref: left is not subset of right"); $LR = is_LsubsetR( [ \@a0, \@a1, \@a2 ], [ 1,2 ] ); ok($LR, "3 indices arrayref: left is subset of right"); $LR = is_LsubsetR( [ \@a2, \@a1, \@a0 ], [ 1,2 ] ); ok(! $LR, "3 indices arrayref: left is not subset of right"); $LR = is_LsubsetR( { lists => [ \@a0, \@a1 ], pair => [ 0,1 ] } ); ok($LR, "lists pair 2 indices: left is subset of right"); $LR = is_LsubsetR( { lists => [ \@a1, \@a0 ], pair => [ 0,1 ] } ); ok(! $LR, "lists pair 2 indices: left is not subset of right"); $LR = is_LsubsetR( { lists => [ \@a0, \@a1, \@a2 ], pair => [ 1,2 ] } ); ok($LR, "lists pair 3 indices: left is subset of right"); $LR = is_LsubsetR( { lists => [ \@a2, \@a1, \@a0 ], pair => [ 1,2 ] } ); ok(! $LR, "lists pair 3 indices: left is not subset of right"); List-Compare-0.53/t/22_oo_hashes_mult_reg_unsorted.t0000755000175000017500000004333212465263760022317 0ustar jkeenanjkeenan# perl #$Id$ # 22_oo_hashes_mult_reg_unsorted.t use strict; use Test::More tests => 110; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :hashes :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; ### new ### my $lcmu = List::Compare->new('-u', \%h0, \%h1, \%h2, \%h3, \%h4); ok($lcmu, "List::Compare constructor returned true value"); %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton icon jerky ); @unpred = qw| kappa |; @union = $lcmu->get_union; $seen{$_}++ foreach (@union); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); $union_ref = $lcmu->get_union_ref; $seen{$_}++ foreach (@{$union_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer hilton icon ); @unpred = qw| abel jerky |; @shared = $lcmu->get_shared; $seen{$_}++ foreach (@shared); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); $shared_ref = $lcmu->get_shared_ref; $seen{$_}++ foreach (@{$shared_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( fargo golfer ); @unpred = qw| abel baker camera delta edward hilton icon jerky |; @intersection = $lcmu->get_intersection; $seen{$_}++ foreach (@intersection); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); $intersection_ref = $lcmu->get_intersection_ref; $seen{$_}++ foreach (@{$intersection_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( jerky ); @unpred = qw| abel baker camera delta edward fargo golfer hilton icon |; @unique = $lcmu->get_unique(2); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcmu->get_unique_ref(2); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @unique = $lcmu->get_Lonly(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $unique_ref = $lcmu->get_Lonly_ref(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { @unique = $lcmu->get_Aonly(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $unique_ref = $lcmu->get_Aonly_ref(2); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Lonly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); @pred = ( [ 'abel' ], [ ], [ 'jerky' ], [ ], [ ], ); $unique_all_ref = $lcmu->get_unique_all(); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %pred = map {$_, 1} qw( abel icon jerky ); @unpred = qw| baker camera delta edward fargo golfer hilton |; @complement = $lcmu->get_complement(1); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcmu->get_complement_ref(1); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @complement = $lcmu->get_Bonly(1); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $complement_ref = $lcmu->get_Bonly_ref(1); }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); %pred = map {$_, 1} qw( hilton icon jerky ); @unpred = qw| abel baker camera delta edward fargo golfer |; @complement = $lcmu->get_complement; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcmu->get_complement_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @complement = $lcmu->get_Ronly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $complement_ref = $lcmu->get_Ronly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { @complement = $lcmu->get_Bonly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly or its alias defaults/, "Got expected warning" ); } %seen = (); { my ($stdout, $stderr); capture( sub { $complement_ref = $lcmu->get_Bonly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_Ronly_ref or its alias defaults/, "Got expected warning" ); } %seen = (); %pred = map {$_, 1} qw( abel jerky ); @unpred = qw| baker camera delta edward fargo golfer hilton icon |; @symmetric_difference = $lcmu->get_symmetric_difference; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcmu->get_symmetric_difference_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcmu->get_symdiff; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcmu->get_symdiff_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); { my ($stdout, $stderr); capture( sub { @symmetric_difference = $lcmu->get_LorRonly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } %seen = (); { my ($stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcmu->get_LorRonly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); } %seen = (); { my ($stdout, $stderr); capture( sub { @symmetric_difference = $lcmu->get_AorBonly; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); like($stderr, qr/When comparing 3 or more lists, \&get_LorRonly or its alias defaults/, "Got expected warning", ); } %seen = (); { my ($stdout, $stderr); capture( sub { $symmetric_difference_ref = $lcmu->get_AorBonly_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); } %seen = (); @pred = ( [ qw( hilton icon jerky ) ], [ qw( abel icon jerky ) ], [ qw( abel baker camera delta edward ) ], [ qw( abel baker camera delta edward jerky ) ], [ qw( abel baker camera delta edward jerky ) ], ); $complement_all_ref = $lcmu->get_complement_all(); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %seen = (); %pred = map {$_, 1} qw( abel baker camera delta edward hilton icon jerky ); @unpred = qw| fargo golfer |; @nonintersection = $lcmu->get_nonintersection; $seen{$_}++ foreach (@nonintersection); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); $nonintersection_ref = $lcmu->get_nonintersection_ref; $seen{$_}++ foreach (@{$nonintersection_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); %seen = (); %pred = ( abel => 2, baker => 2, camera => 2, delta => 3, edward => 2, fargo => 6, golfer => 5, hilton => 4, icon => 5, jerky => 1, ); @unpred = qw| kappa |; @bag = $lcmu->get_bag; $seen{$_}++ foreach (@bag); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $bag_ref = $lcmu->get_bag_ref; $seen{$_}++ foreach (@{$bag_ref}); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $LR = $lcmu->is_LsubsetR(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcmu->is_AsubsetB(3,2); ok($LR, "Got expected subset relationship"); $LR = $lcmu->is_LsubsetR(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcmu->is_AsubsetB(2,3); ok(! $LR, "Got expected subset relationship"); $LR = $lcmu->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcmu->is_RsubsetL; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } { my ($rv, $stdout, $stderr); capture( sub { $RL = $lcmu->is_BsubsetA; }, \$stdout, \$stderr, ); ok(! $RL, "Got expected subset relationship"); like($stderr, qr/When comparing 3 or more lists, \&is_RsubsetL or its alias is restricted/, "Got expected warning", ); } $eqv = $lcmu->is_LequivalentR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcmu->is_LeqvlntR(3,4); ok($eqv, "Got expected equivalence relationship"); $eqv = $lcmu->is_LequivalentR(2,4); ok(! $eqv, "Got expected equivalence relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcmu->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcmu->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } @args = qw( abel baker camera delta edward fargo golfer hilton icon jerky zebra ); is_deeply( all_is_member_which( $lcmu, \@args), $test_member_which_mult, "is_member_which() returned all expected values"); is_deeply( all_is_member_which_ref( $lcmu, \@args), $test_member_which_mult, "is_member_which_ref() returned all expected values"); $memb_hash_ref = $lcmu->are_members_which( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); is_deeply($memb_hash_ref, $test_members_which_mult, "are_members_which() returned all expected values"); is_deeply( all_is_member_any( $lcmu, \@args), $test_member_any_mult, "is_member_which() returned all expected values"); $memb_hash_ref = $lcmu->are_members_any( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); is_deeply($memb_hash_ref, $test_members_any_mult, "are_members_any() returned all expected values"); $vers = $lcmu->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lcmu_dj = List::Compare->new(\%h0, \%h1, \%h2, \%h3, \%h4, \%h8); ok($lcmu_dj, "List::Compare constructor returned true value"); $disj = $lcmu_dj->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); $disj = $lcmu_dj->is_LdisjointR(2,3); ok(! $disj, "Got expected disjoint relationship"); $disj = $lcmu_dj->is_LdisjointR(4,5); ok($disj, "Got expected disjoint relationship"); ########## BELOW: Test for '--unsorted' option ########## my $lcmun = List::Compare->new('--unsorted', \%h0, \%h1, \%h2, \%h3, \%h4); ok($lcmu_dj, "List::Compare constructor returned true value"); List-Compare-0.53/t/25_oo_hashes_alt_dual_reg_sorted.t0000755000175000017500000002462112465263760022563 0ustar jkeenanjkeenan# perl #$Id$ # 25_oo_hashes_alt_dual_reg_sorted.t use strict; use Test::More tests => 79; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :hashes :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref); my @args; ### new ### my $lc = List::Compare->new( { lists => [ \%h0, \%h1 ] } ); ok($lc, "List::Compare constructor returned true value"); @pred = qw(abel baker camera delta edward fargo golfer hilton); @union = $lc->get_union; is_deeply( \@union, \@pred, "Got expected union"); $union_ref = $lc->get_union_ref; is_deeply( $union_ref, \@pred, "Got expected union"); @pred = qw( baker camera delta edward fargo golfer ); @intersection = $lc->get_intersection; is_deeply(\@intersection, \@pred, "Got expected intersection"); $intersection_ref = $lc->get_intersection_ref; is_deeply($intersection_ref, \@pred, "Got expected intersection"); { my ($rv, $stdout, $stderr); capture( sub { @shared = $lc->get_shared; }, \$stdout, \$stderr, ); is_deeply( \@shared, \@pred, "Got expected shared"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } { my ($rv, $stdout, $stderr); capture( sub { $shared_ref = $lc->get_shared_ref; }, \$stdout, \$stderr, ); is_deeply( $shared_ref, \@pred, "Got expected shared"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } @pred = qw( abel ); @unique = $lc->get_unique; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lc->get_unique_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); @unique = $lc->get_Lonly; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lc->get_Lonly_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); @unique = $lc->get_Aonly; is_deeply(\@unique, \@pred, "Got expected unique"); $unique_ref = $lc->get_Aonly_ref; is_deeply($unique_ref, \@pred, "Got expected unique"); @pred = ( [ 'abel' ], [ 'hilton' ], ); $unique_all_ref = $lc->get_unique_all(); is_deeply($unique_all_ref, [ @pred ], "Got expected values for get_unique_all()"); @pred = qw ( hilton ); @complement = $lc->get_complement; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lc->get_complement_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); @complement = $lc->get_Ronly; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lc->get_Ronly_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); @complement = $lc->get_Bonly; is_deeply(\@complement, \@pred, "Got expected complement"); $complement_ref = $lc->get_Bonly_ref; is_deeply($complement_ref, \@pred, "Got expected complement"); @pred = ( [ qw( hilton ) ], [ qw( abel ) ], ); $complement_all_ref = $lc->get_complement_all(); is_deeply($complement_all_ref, [ @pred ], "Got expected values for get_complement_all()"); @pred = qw( abel hilton ); @symmetric_difference = $lc->get_symmetric_difference; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_symmetric_difference_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lc->get_symdiff; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_symdiff_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lc->get_LorRonly; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_LorRonly_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @symmetric_difference = $lc->get_AorBonly; is_deeply(\@symmetric_difference, \@pred, "Got expected symmetric_difference"); $symmetric_difference_ref = $lc->get_AorBonly_ref; is_deeply($symmetric_difference_ref, \@pred, "Got expected symmetric_difference"); @pred = qw( abel hilton ); { my ($rv, $stdout, $stderr); capture( sub { @nonintersection = $lc->get_nonintersection; }, \$stdout, \$stderr, ); is_deeply( \@nonintersection, \@pred, "Got expected nonintersection"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } { my ($rv, $stdout, $stderr); capture( sub { $nonintersection_ref = $lc->get_nonintersection_ref; }, \$stdout, \$stderr, ); is_deeply($nonintersection_ref, \@pred, "Got expected nonintersection"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } @pred = qw( abel abel baker baker camera camera delta delta delta edward edward fargo fargo golfer golfer hilton ); @bag = $lc->get_bag; is_deeply(\@bag, \@pred, "Got expected bag"); $bag_ref = $lc->get_bag_ref; is_deeply($bag_ref, \@pred, "Got expected bag"); $LR = $lc->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); $LR = $lc->is_AsubsetB; ok(! $LR, "Got expected subset relationship"); $RL = $lc->is_RsubsetL; ok(! $RL, "Got expected subset relationship"); $RL = $lc->is_BsubsetA; ok(! $RL, "Got expected subset relationship"); $eqv = $lc->is_LequivalentR; ok(! $eqv, "Got expected equivalent relationship"); $eqv = $lc->is_LeqvlntR; ok(! $eqv, "Got expected equivalent relationship"); $disj = $lc->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lc->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lc->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } ok(wrap_is_member_which( $lc, $test_members_which, ), "is_member_which() returned all expected values"); eval { $memb_arr_ref = $lc->is_member_which('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which() correctly generated error message"); ok(wrap_is_member_which_ref( $lc, $test_members_which, ), "is_member_which_ref() returned all expected values"); eval { $memb_arr_ref = $lc->is_member_which_ref('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_which_ref() correctly generated error message"); $memb_hash_ref = $lc->are_members_which( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); ok(wrap_are_members_which( $memb_hash_ref, $test_members_which, ), "are_members_which() returned all expected value"); eval { $memb_hash_ref = $lc->are_members_which( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_which() correctly generated error message"); ok(wrap_is_member_any( $lc, $test_members_any, ), "is_member_any() returned all expected values"); eval { $lc->is_member_any('jerky', 'zebra') }; like($@, qr/Method call requires exactly 1 argument \(no references\)/, "is_member_any() correctly generated error message"); $memb_hash_ref = $lc->are_members_any( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); ok(wrap_are_members_any( $memb_hash_ref, $test_members_any, ), "are_members_any() returned all expected values"); eval { $memb_hash_ref = $lc->are_members_any( { key => 'value' } ) }; like($@, qr/Method call requires exactly 1 argument which must be an array reference/, "are_members_any() correctly generated error message"); $vers = $lc->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lc_s = List::Compare->new( { lists => [ \%h2, \%h3 ] } ); ok($lc_s, "constructor returned true value"); $LR = $lc_s->is_LsubsetR; ok(! $LR, "non-subset correctly determined"); $LR = $lc_s->is_AsubsetB; ok(! $LR, "non-subset correctly determined"); $RL = $lc_s->is_RsubsetL; ok($RL, "subset correctly determined"); $RL = $lc_s->is_BsubsetA; ok($RL, "subset correctly determined"); $eqv = $lc_s->is_LequivalentR; ok(! $eqv, "non-equivalence correctly determined"); $eqv = $lc_s->is_LeqvlntR; ok(! $eqv, "non-equivalence correctly determined"); $disj = $lc_s->is_LdisjointR; ok(! $disj, "non-disjoint correctly determined"); ### new ### my $lc_e = List::Compare->new( { lists => [ \%h3, \%h4 ] } ); ok($lc_e, "constructor returned true value"); $eqv = $lc_e->is_LequivalentR; ok($eqv, "equivalence correctly determined"); $eqv = $lc_e->is_LeqvlntR; ok($eqv, "equivalence correctly determined"); $disj = $lc_e->is_LdisjointR; ok(! $disj, "non-disjoint correctly determined"); ### new ### my $lc_dj = List::Compare->new( { lists => [ \%h4, \%h8 ] } ); ok($lc_dj, "constructor returned true value"); ok(0 == $lc_dj->get_intersection, "no intersection, as expected"); ok(0 == scalar(@{$lc_dj->get_intersection_ref}), "no intersection, as expected"); $disj = $lc_dj->is_LdisjointR; ok($disj, "disjoint correctly determined"); ########## BELOW: Test for bad arguments to constructor ########## my ($lc_bad); eval { $lc_bad = List::Compare->new( { lists => undef } ) }; like($@, qr/Need to define 'lists' key properly/, "Got expected error message from bad constructor"); eval { $lc_bad = List::Compare->new( { lists => 'not an array ref' } ) }; like($@, qr/Need to define 'lists' key properly/, "Got expected error message from bad constructor"); my $scalar = 'test'; eval { $lc_bad = List::Compare->new( { lists => [ \$scalar, \%h0 ] } ) }; like($@, qr/Must pass all array references or all hash references/, "Got expected error message from bad constructor"); eval { $lc_bad = List::Compare->new( { lists => [ \%h0 ] } ) }; like($@, qr/Must pass at least 2 references/, "Got expected error message from bad constructor"); List-Compare-0.53/t/26_oo_hashes_alt_dual_reg_unsorted.t0000755000175000017500000003577112465263760023137 0ustar jkeenanjkeenan# perl #$Id$ # 26_oo_hashes_alt_dual_reg_unsorted.t use strict; use Test::More tests => 103; use List::Compare; use lib ("./t"); use Test::ListCompareSpecial qw( :seen :wrap :hashes :results ); use IO::CaptureOutput qw( capture ); my @pred = (); my %seen = (); my %pred = (); my @unpred = (); my (@unique, @complement, @intersection, @union, @symmetric_difference, @bag); my ($unique_ref, $complement_ref, $intersection_ref, $union_ref, $symmetric_difference_ref, $bag_ref); my ($LR, $RL, $eqv, $disj, $return, $vers); my (@nonintersection, @shared); my ($nonintersection_ref, $shared_ref); my ($memb_hash_ref, $memb_arr_ref, @memb_arr); my ($unique_all_ref, $complement_all_ref, @seen); my @args; my $test_members_which = { abel => [ 1, [ qw< 0 > ] ], baker => [ 2, [ qw< 0 1 > ] ], camera => [ 2, [ qw< 0 1 > ] ], delta => [ 2, [ qw< 0 1 > ] ], edward => [ 2, [ qw< 0 1 > ] ], fargo => [ 2, [ qw< 0 1 > ] ], golfer => [ 2, [ qw< 0 1 > ] ], hilton => [ 1, [ qw< 1 > ] ], icon => [ 0, [ qw< > ] ], jerky => [ 0, [ qw< > ] ], zebra => [ 0, [ qw< > ] ], }; my $test_members_any = { abel => 1, baker => 1, camera => 1, delta => 1, edward => 1, fargo => 1, golfer => 1, hilton => 1, icon => 0, jerky => 0, zebra => 0, }; ########## BELOW: Tests for '-u' option ########## ### new ### my $lcu = List::Compare->new( { unsorted => 1, lists => [ \%h0, \%h1 ], } ); ok($lcu, "constructor returned true value"); %pred = map {$_, 1} qw( abel baker camera delta edward fargo golfer hilton ); @unpred = qw| icon jerky |; @union = $lcu->get_union; $seen{$_}++ foreach (@union); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); $union_ref = $lcu->get_union_ref; $seen{$_}++ foreach (@{$union_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected union"); ok(unseen(\%seen, \@unpred), "union: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( baker camera delta edward fargo golfer ); @unpred = qw| abel hilton icon jerky |; @intersection = $lcu->get_intersection; $seen{$_}++ foreach (@intersection); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); $intersection_ref = $lcu->get_intersection_ref; $seen{$_}++ foreach (@{$intersection_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected intersection"); ok(unseen(\%seen, \@unpred), "intersection: All non-expected elements correctly excluded"); %seen = (); { my ($rv, $stdout, $stderr); capture( sub { @shared = $lcu->get_shared; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@shared); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); { my ($rv, $stdout, $stderr); capture( sub { $shared_ref = $lcu->get_shared_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$shared_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected shared"); ok(unseen(\%seen, \@unpred), "shared: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); %pred = map {$_, 1} qw( abel ); @unpred = qw| baker camera delta edward fargo golfer hilton icon jerky |; @unique = $lcu->get_unique; $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcu->get_unique_ref; $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @unique = $lcu->get_Lonly; $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcu->get_Lonly_ref; $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @unique = $lcu->get_Aonly; $seen{$_}++ foreach (@unique); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); $unique_ref = $lcu->get_Aonly_ref; $seen{$_}++ foreach (@{$unique_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected unique"); ok(unseen(\%seen, \@unpred), "unique: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ 'abel' ], [ 'hilton' ], ); $unique_all_ref = $lcu->get_unique_all(); is_deeply( make_array_seen_hash($unique_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %pred = map {$_, 1} qw( hilton ); @unpred = qw| abel baker camera delta edward fargo golfer icon jerky |; @complement = $lcu->get_complement; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcu->get_complement_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @complement = $lcu->get_Ronly; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcu->get_Ronly_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @complement = $lcu->get_Bonly; $seen{$_}++ foreach (@complement); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); $complement_ref = $lcu->get_Bonly_ref; $seen{$_}++ foreach (@{$complement_ref}); is_deeply(\%seen, \%pred, "unsorted: got expected complement"); ok(unseen(\%seen, \@unpred), "complement: All non-expected elements correctly excluded"); %seen = (); @pred = ( [ qw( hilton ) ], [ qw( abel ) ], ); $complement_all_ref = $lcu->get_complement_all(); is_deeply( make_array_seen_hash($complement_all_ref), make_array_seen_hash(\@pred), "Got expected values for get_complement_all()"); %pred = map {$_, 1} qw( abel hilton ); @unpred = qw| baker camera delta edward fargo golfer icon jerky |; @symmetric_difference = $lcu->get_symmetric_difference; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_symmetric_difference_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcu->get_symdiff; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_symdiff_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcu->get_LorRonly; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_LorRonly_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); @symmetric_difference = $lcu->get_AorBonly; $seen{$_}++ foreach (@symmetric_difference); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); $symmetric_difference_ref = $lcu->get_AorBonly_ref; $seen{$_}++ foreach (@{$symmetric_difference_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected symmetric difference"); ok(unseen(\%seen, \@unpred), "symmetric difference: All non-expected elements correctly excluded"); %seen = (); %pred = map {$_, 1} qw( abel hilton ); @unpred = qw| baker camera delta edward fargo golfer icon jerky |; { my ($rv, $stdout, $stderr); capture( sub { @nonintersection = $lcu->get_nonintersection; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@nonintersection); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); { my ($rv, $stdout, $stderr); capture( sub { $nonintersection_ref = $lcu->get_nonintersection_ref; }, \$stdout, \$stderr, ); $seen{$_}++ foreach (@{$nonintersection_ref}); is_deeply(\%seen, \%pred, "unsorted: Got expected nonintersection"); ok(unseen(\%seen, \@unpred), "nonintersection: All non-expected elements correctly excluded"); like($stderr, qr/please consider re-coding/, "Got expected warning"); } %seen = (); %pred = ( abel => 2, baker => 2, camera => 2, delta => 3, edward => 2, fargo => 2, golfer => 2, hilton => 1, ); @unpred = qw| icon jerky |; @bag = $lcu->get_bag; $seen{$_}++ foreach (@bag); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $bag_ref = $lcu->get_bag_ref; $seen{$_}++ foreach (@{$bag_ref}); is_deeply(\%seen, \%pred, "Got predicted quantities in bag"); ok(unseen(\%seen, \@unpred), "bag: All non-expected elements correctly excluded"); %seen = (); $LR = $lcu->is_LsubsetR; ok(! $LR, "Got expected subset relationship"); $LR = $lcu->is_AsubsetB; ok(! $LR, "Got expected subset relationship"); $RL = $lcu->is_RsubsetL; ok(! $RL, "Got expected subset relationship"); $RL = $lcu->is_BsubsetA; ok(! $RL, "Got expected subset relationship"); $eqv = $lcu->is_LequivalentR; ok(! $eqv, "Got expected equivalent relationship"); $eqv = $lcu->is_LeqvlntR; ok(! $eqv, "Got expected equivalent relationship"); $disj = $lcu->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcu->print_subset_chart; }, \$stdout, ); ok($rv, "print_subset_chart() returned true value"); like($stdout, qr/Subset Relationships/, "Got expected chart header"); } { my ($rv, $stdout, $stderr); capture( sub { $rv = $lcu->print_equivalence_chart; }, \$stdout, ); ok($rv, "print_equivalence_chart() returned true value"); like($stdout, qr/Equivalence Relationships/, "Got expected chart header"); } ok(wrap_is_member_which( $lcu, $test_members_which, ), "is_member_which() returned all expected values"); ok(wrap_is_member_which_ref( $lcu, $test_members_which, ), "is_member_which_ref() returned all expected values"); $memb_hash_ref = $lcu->are_members_which( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); ok(wrap_are_members_which( $memb_hash_ref, $test_members_which, ), "are_members_which() returned all expected value"); ok(wrap_is_member_any( $lcu, $test_members_any, ), "is_member_any() returned all expected values"); $memb_hash_ref = $lcu->are_members_any( [ qw| abel baker camera delta edward fargo golfer hilton icon jerky zebra | ] ); ok(wrap_are_members_any( $memb_hash_ref, $test_members_any, ), "are_members_any() returned all expected values"); $vers = $lcu->get_version; ok($vers, "get_version() returned true value"); ### new ### my $lcu_s = List::Compare->new( { unsorted => 1, lists => [ \%h2, \%h3 ], } ); ok($lcu_s, "constructor returned true value"); $LR = $lcu_s->is_LsubsetR; ok(! $LR, "non-subset correctly determined"); $LR = $lcu_s->is_AsubsetB; ok(! $LR, "non-subset correctly determined"); $RL = $lcu_s->is_RsubsetL; ok($RL, "subset correctly determined"); $RL = $lcu_s->is_BsubsetA; ok($RL, "subset correctly determined"); $eqv = $lcu_s->is_LequivalentR; ok(! $eqv, "non-equivalence correctly determined"); $eqv = $lcu_s->is_LeqvlntR; ok(! $eqv, "non-equivalence correctly determined"); $disj = $lcu_s->is_LdisjointR; ok(! $disj, "non-disjoint correctly determined"); ### new ### my $lcu_e = List::Compare->new( { unsorted => 1, lists => [ \%h3, \%h4 ], } ); ok($lcu_e, "constructor returned true value"); $eqv = $lcu_e->is_LequivalentR; ok($eqv, "Got expected equivalent relationship"); $eqv = $lcu_e->is_LeqvlntR; ok($eqv, "Got expected equivalent relationship"); $disj = $lcu_e->is_LdisjointR; ok(! $disj, "Got expected disjoint relationship"); ### new ### my $lcu_dj = List::Compare->new( { unsorted => 1, lists => [ \%h4, \%h8 ], } ); ok($lcu_dj, "constructor returned true value"); ok(0 == $lcu_dj->get_intersection, "no intersection, as expected"); ok(0 == scalar(@{$lcu_dj->get_intersection_ref}), "no intersection, as expected"); $disj = $lcu_dj->is_LdisjointR; ok($disj, "disjoint correctly determined"); ########## BELOW: Tests for '--unsorted' option ########## my $lcun = List::Compare->new( { unsorted => 1, lists => [ \%h0, \%h1 ], } ); ok($lcun, "constructor returned true value"); my $lcun_s = List::Compare->new( { unsorted => 1, lists => [ \%h2, \%h3 ], } ); ok($lcun_s, "constructor returned true value"); my $lcun_e = List::Compare->new( { unsorted => 1, lists => [ \%h3, \%h4 ], } ); ok($lcun_e, "constructor returned true value"); List-Compare-0.53/lib/0000755000175000017500000000000012535073324014322 5ustar jkeenanjkeenanList-Compare-0.53/lib/List/0000755000175000017500000000000012535073324015235 5ustar jkeenanjkeenanList-Compare-0.53/lib/List/Compare/0000755000175000017500000000000012535073324016623 5ustar jkeenanjkeenanList-Compare-0.53/lib/List/Compare/Functional.pm0000644000175000017500000014512012535072713021267 0ustar jkeenanjkeenanpackage List::Compare::Functional; $VERSION = 0.53; @ISA = qw(Exporter); @EXPORT_OK = qw| get_intersection get_intersection_ref get_union get_union_ref get_unique get_unique_ref get_unique_all get_complement get_complement_ref get_complement_all get_symmetric_difference get_symmetric_difference_ref is_LsubsetR is_RsubsetL is_LequivalentR is_LdisjointR is_member_which is_member_which_ref are_members_which is_member_any are_members_any print_subset_chart print_equivalence_chart get_shared get_shared_ref get_nonintersection get_nonintersection_ref get_symdiff get_symdiff_ref is_LeqvlntR get_bag get_bag_ref get_version |; %EXPORT_TAGS = ( main => [ qw( get_intersection get_union get_unique get_complement get_symmetric_difference is_LsubsetR ) ], mainrefs => [ qw( get_intersection_ref get_union_ref get_unique_ref get_complement_ref get_symmetric_difference_ref ) ], originals => [ qw( get_intersection get_intersection_ref get_union get_union_ref get_unique get_unique_ref get_unique_all get_complement get_complement_ref get_complement_all get_symmetric_difference get_symmetric_difference_ref get_shared get_shared_ref get_nonintersection get_nonintersection_ref is_LsubsetR is_RsubsetL is_LequivalentR is_LdisjointR is_member_which is_member_which_ref are_members_which is_member_any are_members_any print_subset_chart print_equivalence_chart get_bag get_bag_ref get_version ) ], aliases => [ qw( get_symdiff get_symdiff_ref is_LeqvlntR ) ], ); use strict; local $^W = 1; use Carp; use List::Compare::Base::_Auxiliary qw( _subset_subengine _chart_engine_multiple _equivalent_subengine _calc_seen1 ); use List::Compare::Base::_Auxiliary qw(:calculate :checker :tester); use List::Compare::Base::_Engine qw( _unique_all_engine _complement_all_engine ); sub get_union { return @{ get_union_ref(@_) }; } sub get_union_ref { my ($argref, $unsorted) = _alt_construct_tester(@_); $unsorted ? return _union_engine(_argument_checker($argref)) : return [ sort @{_union_engine(_argument_checker($argref))} ]; } sub _union_engine { my $seenrefsref = _calc_seen1(@_); my $unionhashref = _calculate_union_only($seenrefsref); return [ keys %{$unionhashref} ]; } sub get_intersection { return @{ get_intersection_ref(@_) }; } sub get_intersection_ref { my ($argref, $unsorted) = _alt_construct_tester(@_); $unsorted ? return _intersection_engine(_argument_checker($argref)) : return [ sort @{_intersection_engine(_argument_checker($argref))} ]; } sub _intersection_engine { my $seenrefsref = _calc_seen1(@_); my @vals = sort { scalar(keys(%{$a})) <=> scalar(keys(%{$b})) } @{$seenrefsref}; my %intersection = map { $_ => 1 } keys %{$vals[0]}; for my $l ( 1..$#vals ) { %intersection = map { $_ => 1 } grep { exists $intersection{$_} } keys %{$vals[$l]}; } return [ keys %intersection ]; } sub get_unique { return @{ get_unique_ref(@_) }; } sub get_unique_ref { my ($argref, $unsorted) = _alt_construct_tester_3(@_); $unsorted ? return _unique_engine(_argument_checker_3($argref)) : return [ sort @{_unique_engine(_argument_checker_3($argref))} ]; } sub get_unique_all { my ($argref, $unsorted) = _alt_construct_tester_3(@_); # currently it doesn't appear that &_unique_all_engine can make use of # $unsorted return _unique_all_engine(_argument_checker_3a($argref)); } sub _unique_engine { my $index = pop(@_); my $seenref = _calculate_seen_only(_calc_seen1(@_)); my %seen_in_all_others = (); my @seenthis = (); for my $i (keys %{$seenref}) { unless ($i == $index) { for my $k (keys %{$seenref->{$i}}) { $seen_in_all_others{$k}++; } } else { @seenthis = keys %{$seenref->{$index}}; } } my @unique_to_this_index = (); for my $s (@seenthis) { push @unique_to_this_index, $s unless $seen_in_all_others{$s}; } return \@unique_to_this_index; } sub get_complement { return @{ get_complement_ref(@_) }; } sub get_complement_ref { my ($argref, $unsorted) = _alt_construct_tester_3(@_); $unsorted ? return _complement_engine(_argument_checker_3($argref)) : return [ sort @{_complement_engine(_argument_checker_3($argref))} ]; } sub get_complement_all { my ($argref, $unsorted) = _alt_construct_tester_3(@_); return _complement_all_engine(_argument_checker_3a($argref), $unsorted); } sub _complement_engine { my $tested = pop(@_); my $seenrefsref = _calc_seen1(@_); my ($unionref, $seenref) = _calculate_union_seen_only($seenrefsref); # Calculate %xcomplement # Inputs: $seenrefsref @union (keys %$unionref) my (%xcomplement); for (my $i = 0; $i <= $#{$seenrefsref}; $i++) { my @complementthis = (); foreach my $k (keys %{$unionref}) { push(@complementthis, $k) unless (exists $seenref->{$i}->{$k}); } $xcomplement{$i} = \@complementthis; } return [ @{$xcomplement{$tested}} ]; } sub get_symmetric_difference { return @{ get_symmetric_difference_ref(@_) }; } sub get_symmetric_difference_ref { my ($argref, $unsorted) = _alt_construct_tester(@_); $unsorted ? return _symmetric_difference_engine(_argument_checker($argref)) : return [ sort @{_symmetric_difference_engine(_argument_checker($argref))} ]; } sub _symmetric_difference_engine { # Get those items which do not appear in more than one of several lists (their symmetric_difference); my $seenrefsref = _calc_seen1(@_); my $unionref = _calculate_union_only($seenrefsref); my $sharedref = _calculate_sharedref($seenrefsref); my (@symmetric_difference); for my $k (keys %{$unionref}) { push(@symmetric_difference, $k) unless exists $sharedref->{$k}; } return \@symmetric_difference; } *get_symdiff = \&get_symmetric_difference; *get_symdiff_ref = \&get_symmetric_difference_ref; sub get_shared { return @{ get_shared_ref(@_) }; } sub get_shared_ref { my ($argref, $unsorted) = _alt_construct_tester(@_); $unsorted ? return _shared_engine(_argument_checker($argref)) : return [ sort @{_shared_engine(_argument_checker($argref))} ]; } sub _shared_engine { my $seenrefsref = _calc_seen1(@_); my $sharedref = _calculate_sharedref($seenrefsref); return [ keys %{$sharedref} ]; } sub get_nonintersection { return @{ get_nonintersection_ref(@_) }; } sub get_nonintersection_ref { my ($argref, $unsorted) = _alt_construct_tester(@_); $unsorted ? return _nonintersection_engine(_argument_checker($argref)) : return [ sort @{_nonintersection_engine(_argument_checker($argref))} ]; } sub _nonintersection_engine { my $seenrefsref = _calc_seen1(@_); my $unionref = _calculate_union_only($seenrefsref); my @vals = sort { scalar(keys(%{$a})) <=> scalar(keys(%{$b})) } @{$seenrefsref}; my %intersection = map { $_ => 1 } keys %{$vals[0]}; for my $l ( 1..$#vals ) { %intersection = map { $_ => 1 } grep { exists $intersection{$_} } keys %{$vals[$l]}; } # Calculate nonintersection # Inputs: @union (keys %$unionref) %intersection my (@nonintersection); for my $k (keys %{$unionref}) { push(@nonintersection, $k) unless exists $intersection{$k}; } return \@nonintersection; } sub is_LsubsetR { my $argref = _alt_construct_tester_4(@_); return _is_LsubsetR_engine(_argument_checker_4($argref)); } sub _is_LsubsetR_engine { my $testedref = pop(@_); my $xsubsetref = _subset_engine(@_); return ${$xsubsetref}[${$testedref}[0]][${$testedref}[1]]; } sub is_RsubsetL { my $argref = _alt_construct_tester_4(@_); return _is_RsubsetL_engine(_argument_checker_4($argref)); } sub _is_RsubsetL_engine { my $testedref = pop(@_); my $xsubsetref = _subset_engine(@_); return ${$xsubsetref}[${$testedref}[1]][${$testedref}[0]]; } sub _subset_engine { my $seenrefsref = _calc_seen1(@_); my $xsubsetref = _subset_subengine($seenrefsref); return $xsubsetref; } sub is_LequivalentR { my $argref = _alt_construct_tester_4(@_); return _is_LequivalentR_engine(_argument_checker_4($argref)); } *is_LeqvlntR = \&is_LequivalentR; sub _is_LequivalentR_engine { my $testedref = pop(@_); my $seenrefsref = _calc_seen1(@_); my $xequivalentref = _equivalent_subengine($seenrefsref); return ${$xequivalentref}[${$testedref}[1]][${$testedref}[0]]; } sub is_LdisjointR { my $argref = _alt_construct_tester_4(@_); return _is_LdisjointR_engine(_argument_checker_4($argref)); } sub _is_LdisjointR_engine { my $testedref = pop(@_); my $seenrefsref = _calc_seen1(@_); my $disjoint = 1; # start out assuming disjoint status OUTER: for my $k (keys %{$seenrefsref->[$testedref->[0]]}) { if ($seenrefsref->[$testedref->[1]]->{$k}) { $disjoint = 0; last OUTER; } } return $disjoint; } sub print_subset_chart { my $argref = _alt_construct_tester_5(@_); _print_subset_chart_engine(_argument_checker($argref)); } sub _print_subset_chart_engine { my $seenrefsref = _calc_seen1(@_); my $xsubsetref = _subset_subengine($seenrefsref); my $title = 'Subset'; _chart_engine_multiple($xsubsetref, $title); } sub print_equivalence_chart { my $argref = _alt_construct_tester_5(@_); _print_equivalence_chart_engine(_argument_checker($argref)); } sub _print_equivalence_chart_engine { my $seenrefsref = _calc_seen1(@_); my $xequivalentref = _equivalent_subengine($seenrefsref); my $title = 'Equivalence'; _chart_engine_multiple($xequivalentref, $title); } sub is_member_which { return @{ is_member_which_ref(@_) }; } sub is_member_which_ref { my $argref = _alt_construct_tester_1(@_); return _is_member_which_engine(_argument_checker_1($argref)); } sub _is_member_which_engine { my $arg = pop(@_); my $seenrefsref = _calc_seen1(@_); my $seenref = _calculate_seen_only($seenrefsref); my (@found); foreach (sort keys %{$seenref}) { push @found, $_ if (exists ${$seenref}{$_}{$arg}); } return \@found; } sub is_member_any { my $argref = _alt_construct_tester_1(@_); return _is_member_any_engine(_argument_checker_1($argref)); } sub _is_member_any_engine { my $tested = pop(@_); my $seenrefsref = _calc_seen1(@_); my $seenref = _calculate_seen_only($seenrefsref); my ($k); while ( $k = each %{$seenref} ) { return 1 if (defined ${$seenref}{$k}{$tested}); } return 0; } sub are_members_which { my $argref = _alt_construct_tester_2(@_); return _are_members_which_engine(_argument_checker_2($argref)); } sub _are_members_which_engine { my $testedref = pop(@_); my @tested = @{$testedref}; my $seenrefsref = _calc_seen1(@_); my $seenref = _calculate_seen_only($seenrefsref); my (%found); for (my $i=0; $i<=$#tested; $i++) { my (@not_found); foreach (sort keys %{$seenref}) { exists ${${$seenref}{$_}}{$tested[$i]} ? push @{$found{$tested[$i]}}, $_ : push @not_found, $_; } $found{$tested[$i]} = [] if (@not_found == keys %{$seenref}); } return \%found; } sub are_members_any { my $argref = _alt_construct_tester_2(@_); return _are_members_any_engine(_argument_checker_2($argref)); } sub _are_members_any_engine { my $testedref = pop(@_); my @tested = @{$testedref}; my $seenrefsref = _calc_seen1(@_); my $seenref = _calculate_seen_only($seenrefsref); my (%present); for (my $i=0; $i<=$#tested; $i++) { foreach (keys %{$seenref}) { unless (defined $present{$tested[$i]}) { $present{$tested[$i]} = 1 if ${$seenref}{$_}{$tested[$i]}; } } $present{$tested[$i]} = 0 if (! defined $present{$tested[$i]}); } return \%present; } sub get_bag { return @{ get_bag_ref(@_) }; } sub get_bag_ref { my ($argref, $unsorted) = _alt_construct_tester(@_); $unsorted ? return _bag_engine(_argument_checker($argref)) : return [ sort @{_bag_engine(_argument_checker($argref))} ]; } sub _bag_engine { my @listrefs = @_; my (@bag); if (ref($listrefs[0]) eq 'ARRAY') { foreach my $lref (@listrefs) { foreach my $el (@{$lref}) { push(@bag, $el); } } } else { foreach my $lref (@listrefs) { foreach my $key (keys %{$lref}) { for (my $j=1; $j <= ${$lref}{$key}; $j++) { push(@bag, $key); } } } } return \@bag; } sub get_version { return $List::Compare::Functional::VERSION; } 1; __END__ =head1 NAME List::Compare::Functional - Compare elements of two or more lists =head1 VERSION This document refers to version 0.53 of List::Compare::Functional. This version was released June 07 2015. The first released version of List::Compare::Functional was v0.21. Its version numbers are set to be consistent with the other parts of the List::Compare distribution. =head2 Notice of Interface Changes Certain significant changes to the interface to List::Compare::Functional were made with the introduction of Version 0.25 in April 2004. The documentation immediately below reflects those changes, so if you are first using this module with that or a later version, simply read and follow the documentation below. If, however, you used List::Compare::Functional prior to that version, see the discussion of interface changes farther below: April 2004 Change of Interface. =head1 SYNOPSIS =head2 Getting Started List::Compare::Functional exports no subroutines by default. use List::Compare::Functional qw(:originals :aliases); will import all publicly available subroutines from List::Compare::Functional. The model for importing just one subroutine from List::Compare::Functional is: use List::Compare::Functional qw( get_intersection ); It will probably be most convenient for the user to import functions by using one of the two following export tags: use List::Compare::Functional qw(:main :mainrefs); The assignment of the various comparison functions to export tags is discussed below. For clarity, we shall begin by discussing comparisons of just two lists at a time. Farther below, we shall discuss comparisons among three or more lists at a time. =head2 Comparing Two Lists Held in Arrays =over 4 =item * Given two lists: @Llist = qw(abel abel baker camera delta edward fargo golfer); @Rlist = qw(baker camera delta delta edward fargo golfer hilton); =item * Get those items which appear at least once in both lists (their intersection). @intersection = get_intersection( [ \@Llist, \@Rlist ] ); Note that you could place the references to the lists being compared into a named array and then pass C a reference to that array. @to_be_compared = ( \@Llist, \@Rlist ); @intersection = get_intersection( \@to_be_compared ); Beginning with version 0.29 (May 2004), List::Compare::Functional now offers an additional way of passing arguments to its various functions. If you prefer to see a more explicit delineation among the types of arguments passed to a function, pass a single hash reference which holds the lists being compared in an anonymous array which is the value corresponding to key C: @intersection = get_intersection( { lists => [ \@Llist, \@Rlist ], } ); =item * Get those items which appear at least once in either list (their union). @union = get_union( [ \@Llist, \@Rlist ] ); or @union = get_union( { lists => [ \@Llist, \@Rlist ] } ); =item * Get those items which appear (at least once) only in the first list. @Lonly = get_unique( [ \@Llist, \@Rlist ] ); or @Lonly = get_unique( { lists => [ \@Llist, \@Rlist ] } ); =item * Get those items which appear (at least once) only in the second list. @Ronly = get_complement( [ \@Llist, \@Rlist ] ); or @Ronly = get_complement( { lists => [ \@Llist, \@Rlist ] } ); =item * @LorRonly = get_symmetric_difference( [ \@Llist, \@Rlist ] ); @LorRonly = get_symdiff( [ \@Llist, \@Rlist ] ); # alias or @LorRonly = get_symmetric_difference( { lists => [ \@Llist, \@Rlist ] } ); =item * Make a bag of all those items in both lists. The bag differs from the union of the two lists in that it holds as many copies of individual elements as appear in the original lists. @bag = get_bag( [ \@Llist, \@Rlist ] ); or @bag = get_bag( { lists => [ \@Llist, \@Rlist ] } ); =item * An alternative approach to the above functions: If you do not immediately require an array as the return value of the function call, but simply need a I to an (anonymous) array, use one of the following parallel functions: $intersection_ref = get_intersection_ref( [ \@Llist, \@Rlist ] ); $union_ref = get_union_ref( [ \@Llist, \@Rlist ] ); $Lonly_ref = get_unique_ref( [ \@Llist, \@Rlist ] ); $Ronly_ref = get_complement_ref( [ \@Llist, \@Rlist ] ); $LorRonly_ref = get_symmetric_difference_ref( [ \@Llist, \@Rlist ] ); $LorRonly_ref = get_symdiff_ref( [ \@Llist, \@Rlist ] ); # alias $bag_ref = get_bag_ref( [ \@Llist, \@Rlist ] ); or $intersection_ref = get_intersection_ref( { lists => [ \@Llist, \@Rlist ] } ); $union_ref = get_union_ref( { lists => [ \@Llist, \@Rlist ] } ); $Lonly_ref = get_unique_ref( { lists => [ \@Llist, \@Rlist ] } ); $Ronly_ref = get_complement_ref( { lists => [ \@Llist, \@Rlist ] } ); $LorRonly_ref = get_symmetric_difference_ref( { lists => [ \@Llist, \@Rlist ] } ); $LorRonly_ref = get_symdiff_ref( { lists => [ \@Llist, \@Rlist ] } ); # alias $bag_ref = get_bag_ref( { lists => [ \@Llist, \@Rlist ] } ); =item * Return a true value if the first list ('L' for 'left') is a subset of the second list ('R' for 'right'). $LR = is_LsubsetR( [ \@Llist, \@Rlist ] ); or $LR = is_LsubsetR( { lists => [ \@Llist, \@Rlist ] } ); =item * Return a true value if R is a subset of L. $RL = is_RsubsetL( [ \@Llist, \@Rlist ] ); or $RL = is_RsubsetL( { lists => [ \@Llist, \@Rlist ] } ); =item * Return a true value if L and R are equivalent, I if every element in L appears at least once in R and I. $eqv = is_LequivalentR( [ \@Llist, \@Rlist ] ); $eqv = is_LeqvlntR( [ \@Llist, \@Rlist ] ); # alias or $eqv = is_LequivalentR( { lists => [ \@Llist, \@Rlist ] } ); =item * Return a true value if L and R are disjoint, I if L and R have no common elements. $disj = is_LdisjointR( [ \@Llist, \@Rlist ] ); or $disj = is_LdisjointR( { lists => [ \@Llist, \@Rlist ] } ); =item * Pretty-print a chart showing whether one list is a subset of the other. print_subset_chart( [ \@Llist, \@Rlist ] ); or print_subset_chart( { lists => [ \@Llist, \@Rlist ] } ); =item * Pretty-print a chart showing whether the two lists are equivalent (same elements found at least once in both). print_equivalence_chart( [ \@Llist, \@Rlist ] ); or print_equivalence_chart( { lists => [ \@Llist, \@Rlist ] } ); =item * Determine in I (if any) of the lists a given string can be found. In list context, return a list of those indices in the argument list corresponding to lists holding the string being tested. @memb_arr = is_member_which( [ \@Llist, \@Rlist ] , [ 'abel' ] ); or @memb_arr = is_member_which( { lists => [ \@Llist, \@Rlist ], # value is array reference item => 'abel', # value is string } ); In the example above, C<@memb_arr> will be: ( 0 ) because C<'abel'> is found only in C<@Al> which holds position C<0> in the list of arguments passed to C. =item * As with other List::Compare::Functional functions which return a list, you may wish the above function returned a (scalar) reference to an array holding the list: $memb_arr_ref = is_member_which_ref( [ \@Llist, \@Rlist ] , [ 'baker' ] ); or $memb_arr_ref = is_member_which_ref( { lists => [ \@Llist, \@Rlist ], # value is array reference item => 'baker', # value is string } ); In the example above, C<$memb_arr_ref> will be: [ 0, 1 ] because C<'baker'> is found in C<@Llist> and C<@Rlist>, which hold positions C<0> and C<1>, respectively, in the list of arguments passed to C. B functions C and C test only one string at a time and hence take only one argument. To test more than one string at a time see the next function, C. =item * Determine in C (if any) of the lists passed as arguments one or more given strings can be found. The lists beings searched are placed in an array, a reference to which is the first argument passed to C. The strings to be tested are also placed in an array, a reference to which is the second argument passed to that function. $memb_hash_ref = are_members_which( [ \@Llist, \@Rlist ] , [ qw| abel baker fargo hilton zebra | ] ); or $memb_hash_ref = are_members_which( { lists => [ \@Llist, \@Rlist ], # value is arrayref items => [ qw| abel baker fargo hilton zebra | ], # value is arrayref } ); The return value is a reference to a hash of arrays. The key for each element in this hash is the string being tested. Each element's value is a reference to an anonymous array whose elements are those indices in the constructor's argument list corresponding to lists holding the strings being tested. In the examples above, C<$memb_hash_ref> will be: { abel => [ 0 ], baker => [ 0, 1 ], fargo => [ 0, 1 ], hilton => [ 1 ], zebra => [ ], }; B C can take more than one argument; C and C each take only one argument. Unlike those functions, C returns a hash reference. =item * Determine whether a given string can be found in I of the lists passed as arguments. Return C<1> if a specified string can be found in any of the lists and C<0> if not. $found = is_member_any( [ \@Llist, \@Rlist ] , [ 'abel' ] ); or $found = is_member_any( { lists => [ \@Llist, \@Rlist ], # value is array reference item => 'abel', # value is string } ); In the example above, C<$found> will be C<1> because C<'abel'> is found in one or more of the lists passed as arguments to C. =item * Determine whether a specified string or strings can be found in I of the lists passed as arguments. The lists beings searched are placed in an array, a reference to which is the first argument passed to C. The strings to be tested are also placed in an array, a reference to which is the second argument passed to that function. $memb_hash_ref = are_members_any( [ \@Llist, \@Rlist ] , [ qw| abel baker fargo hilton zebra | ] ); or $memb_hash_ref = are_members_any( { lists => [ \@Llist, \@Rlist ], # value is arrayref items => [ qw| abel baker fargo hilton zebra | ], # value is arrayref } ); The return value is a reference to a hash where an element's key is the string being tested and the element's value is C<1> if the string can be found in I of the lists and C<0> if not. In the examples above, C<$memb_hash_ref> will be: { abel => 1, baker => 1, fargo => 1, hilton => 1, zebra => 0, }; C's value is C<0> because C is not found in either of the lists passed as arguments to C. =item * Return current List::Compare::Functional version number. $vers = get_version; =back =head2 Comparing Three or More Lists Held in Arrays Given five lists: @Al = qw(abel abel baker camera delta edward fargo golfer); @Bob = qw(baker camera delta delta edward fargo golfer hilton); @Carmen = qw(fargo golfer hilton icon icon jerky kappa); @Don = qw(fargo icon jerky); @Ed = qw(fargo icon icon jerky); =over 4 =item * Get those items which appear at least once in I list (their intersection). @intersection = get_intersection( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ] ); or @intersection = get_intersection( { lists => [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], } ); =item * Get those items which appear at least once in I of the lists (their union). @union = get_union( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ] ); or @union = get_union( { lists => [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], } ); =item * To get those items which are unique to a particular list, provide C with two array references. The first holds references to the arrays which in turn hold the individual lists being compared. The second holds the index position in the first reference of the particular list under consideration. Example: To get elements unique to C<@Carmen>: @Lonly = get_unique( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], [ 2 ] ); or @Lonly = get_unique( { lists => [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], # value is arrayref item => 2, # value is number } ); If no index position is passed to C it will default to C<0> and report items unique to the first list passed to the function. Hence, @Lonly = get_unique( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ] ); is same as: @Lonly = get_unique( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], [ 0 ] ); =item * Should you need to identify the items unique to I of the lists under consideration, call C and get a reference to an array of array references: $unique_all_ref = get_unique_all( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ] ); or $unique_all_ref = get_unique_all( { lists => [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], } ); =item * To get those items which appear only in lists I one particular list, pass two array references to the C function. The first holds references to the arrays which in turn hold the individual lists being compared. The second holds the index position in the first reference of the particular list under consideration. Example: to get all the elements found in lists other than C<@Don>: @Ronly = get_complement( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], [ 3 ] ); or @Ronly = get_complement( { lists => [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], # value is arrayref item => 3, # value is number } ); If no index position is passed to C it will default to C<0> and report items found in all lists I the first list passed to C. @Lonly = get_complement( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ] ); is same as: @Lonly = get_complement( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], [ 0 ] ); =item * Should you need to identify the items not found in I of the lists under consideration, call C and get a reference to an array of array references: $complement_all_ref = get_complement_all( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ] ); or $complement_all_ref = get_complement_all( { lists => [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], } ); =item * Get those items which do I appear in I of several lists (their symmetric_difference); @LorRonly = get_symmetric_difference( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ] ); @LorRonly = get_symdiff( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ] ); # alias or @LorRonly = get_symmetric_difference( { lists => [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], } ); =item * Get those items found in I of several lists which do I appear in C of the lists (I all items except those found in the intersection of the lists): @nonintersection = get_nonintersection( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ] ); or @nonintersection = get_nonintersection( { lists => [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], } ); =item * Get those items which appear in I of several lists (I all items except those found in their symmetric difference); @shared = get_shared( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ] ); or @shared = get_shared( { lists => [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], } ); =item * Make a bag of every item found in every list. The bag differs from the union of the two lists in that it holds as many copies of individual elements as appear in the original lists. @bag = get_bag( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ] ); or @bag = get_bag( { lists => [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], } ); =item * An alternative approach to the above functions: If you do not immediately require an array as the return value of the function, but simply need a I to an array, use one of the following parallel functions: $intersection_ref = get_intersection_ref( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ] ); $union_ref = get_union_ref( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ] ); $Lonly_ref = get_unique_ref( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ] ); $Ronly_ref = get_complement_ref( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ] ); $LorRonly_ref = get_symmetric_difference_ref( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ] ); $LorRonly_ref = get_symdiff_ref( # alias [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ] ); $nonintersection_ref = get_nonintersection_ref( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ] ); $shared_ref = get_shared_ref( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ] ); $bag_ref = get_bag_ref( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ] ); =item * To determine whether one particular list is a subset of another of the lists passed to the function, pass to C two array references. The first of these is a reference to an array of array references, the arrays holding the lists under consideration. The second is a reference to a two-element array consisting of the index of the presumed subset, followed by the index position of the presumed superset. A true value (C<1>) is returned if the first (left-hand) element in the second reference list is a subset of the second (right-hand) element; a false value (C<0>) is returned otherwise. Example: To determine whether C<@Ed> is a subset of C<@Carmen>, call: $LR = is_LsubsetR( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], [ 4, 2 ] ); or $LR = is_LsubsetR( { lists => [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], # value is arrayref pair => [ 4, 2 ], # value is arrayref } ); If only the first reference (to the array of lists) is passed to C, then the function's second argument defaults to C<(0,1)> and compares the first two lists passed to the constructor. So, $LR = is_LsubsetR([ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ] ); ... is equivalent to: $LR = is_LsubsetR([ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], [0,1] ); =item * To reverse the order in which the particular lists are evaluated for superset/subset status, call C: $RL = is_RsubsetL([ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], [2,4] ); or $RL = is_RsubsetL( { lists => [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], pair => [ 2, 4 ], } ); =item * List::Compare::Functional considers two lists to be equivalent if every element in one list appears at least once in R and I. To determine whether one particular list passed to the function is equivalent to another of the lists passed to the function, provide C with two array references. The first is a reference to an array of array references, the arrays holding the lists under consideration. The second of these is a reference to a two-element array consisting of the two lists being tested for equivalence. A true value (C<1>) is returned if the lists are equivalent; a false value (C<0>) is returned otherwise. Example: To determine whether C<@Don> and C<@Ed> are equivalent, call: $eqv = is_LequivalentR( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], [3,4] ); $eqv = is_LeqvlntR( # alias [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], [3,4] ); or $eqv = is_LequivalentR( { items => [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], pair => [3,4], } ); If no arguments are passed, C defaults to C<[0,1]> and compares the first two lists passed to the function. So, $eqv = is_LequivalentR( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ] ); ... translates to: $eqv = is_LequivalentR( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], [0,1] ); =item * To determine whether any two of the lists passed to the function are disjoint from one another (I have no common members), provide C with two array references. The first is a reference to an array of array references, the arrays holding the lists under consideration. The second of these is a reference to a two-element array consisting of the two lists being tested for disjointedness. A true value (C<1>) is returned if the lists are disjoint; a false value (C<0>) is returned otherwise. Example: To determine whether C<@Don> and C<@Ed> are disjoint, call: $disj = is_LdisjointR( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], [3,4] ); or $disj = is_LdisjointR( { items => [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], pair => [3,4] } ); =item * Pretty-print a chart showing the subset relationships among the various source lists: print_subset_chart( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ] ); or print_subset_chart( { lists => [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ] } ); =item * Pretty-print a chart showing the equivalence relationships among the various source lists: print_equivalence_chart( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ] ); or print_equivalence_chart( { lists => [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ] } ); =item * Determine in I (if any) of several lists a given string can be found. Pass two array references, the first of which holds references to arrays holding the lists under consideration, and the second of which holds a single-item list consisting of the string being tested. @memb_arr = is_member_which( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], [ 'abel' ] ); or @memb_arr = is_member_which( { lists => [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], # value is arrayref item => 'abel', # value is string } ); In list context, return a list of those indices in the function's argument list corresponding to lists holding the string being tested. In the example above, C<@memb_arr> will be: ( 0 ) because C<'abel'> is found only in C<@Al> which holds position C<0> in the list of arguments passed to C. =item * As with other List::Compare::Functional functions which return a list, you may wish the above function returned a reference to an array holding the list: $memb_arr_ref = is_member_which_ref( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], [ 'jerky' ] ); or $memb_arr_ref = is_member_which_ref( { lists => [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], # value is arrayref item => 'jerky', # value is string } ); In the example above, C<$memb_arr_ref> will be: [ 3, 4 ] because C<'jerky'> is found in C<@Don> and C<@Ed>, which hold positions C<3> and C<4>, respectively, in the list of arguments passed to C. B functions C and C test only one string at a time and hence take only one element in the second array reference argument. To test more than one string at a time see the next function, C. =item * Determine in C (if any) of several lists one or more given strings can be found. Pass two array references, the first of which holds references to arrays holding the lists under consideration, and the second of which holds a list of the strings being tested. $memb_hash_ref = are_members_which( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], [ qw| abel baker fargo hilton zebra | ] ); or $memb_hash_ref = are_members_which( { lists => [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], # value is arrayref items => [ qw| abel baker fargo hilton zebra | ], # value is arrayref } ); The return valus is a reference to a hash of arrays. In this hash, each element's value is a reference to an anonymous array whose elements are those indices in the argument list corresponding to lists holding the strings being tested. In the two examples above, C<$memb_hash_ref> will be: { abel => [ 0 ], baker => [ 0, 1 ], fargo => [ 0, 1, 2, 3, 4 ], hilton => [ 1, 2 ], zebra => [ ], }; B C tests more than one string at a time. Hence, its second array reference argument can take more than one element. C and C each take only one element in their second array reference arguments. C returns a hash reference; the other functions return either a list or a reference to an array holding that list, depending on context. =item * Determine whether a given string can be found in I of several lists. Pass two array references, the first of which holds references to arrays holding the lists under consideration, and the second of which holds a single-item list of the string being tested. $found = is_member_any( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], [ 'abel' ] ); or $found = is_member_any( { lists => [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], # value is arrayref item => 'abel', # value is string } ); The return value is C<1> if a specified string can be found in I of the lists and C<0> if not. In the example above, C<$found> will be C<1> because C is found in one or more of the lists passed as arguments to C. =item * Determine whether a specified string or strings can be found in I of several lists. Pass two array references, the first of which holds references to arrays holding the lists under consideration, and the second of which holds a list of the strings being tested. $memb_hash_ref = are_members_any( [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], [ qw| abel baker fargo hilton zebra | ] ); or $memb_hash_ref = are_members_any( { lists => [ \@Al, \@Bob, \@Carmen, \@Don, \@Ed ], # value is arrayref items => [ qw| abel baker fargo hilton zebra | ], # value is arrayref } ); The return value is a reference to a hash where an element's key is the string being tested and the element's value is C<1> if the string can be found in any of the lists and C<0> if not. In the example above, C<$memb_hash_ref> will be: { abel => 1, baker => 1, fargo => 1, hilton => 1, zebra => 0, }; C's value is C<0> because C is not found in any of the lists passed as arguments to C. =item * Return current List::Compare::Functional version number: $vers = get_version; =back =head2 Comparing Lists Held in Seen-Hashes What is a seen-hash? A seen-hash is a typical Perl implementation of a look-up table: a hash where the value for a given element represents the number of times the element's key is observed in a list. For the purposes of List::Compare::Functional, what is crucial is whether an item is observed in a list or not; how many times the item occurs in a list is, I irrelevant. (That exception is the C function and its fraternal twin C. In this case only, the key in each element of the seen-hash is placed in the bag the number of times indicated by the value of that element.) The value of an element in a List::Compare seen-hash must be a positive integer, but whether that integer is 1 or 1,000,001 is immaterial for all List::Compare::Functional functions I forming a bag. The two lists compared above were represented by arrays; references to those arrays were passed to the various List::Compare::Functional functions. They could, however, have been represented by seen-hashes such as the following and passed in exactly the same manner to the various functions. %Llist = ( abel => 2, baker => 1, camera => 1, delta => 1, edward => 1, fargo => 1, golfer => 1, ); %Rlist = ( baker => 1, camera => 1, delta => 2, edward => 1, fargo => 1, golfer => 1, hilton => 1, ); @intersection = get_intersection( [ \%Llist, \%Rlist ] ); @union = get_union( [ \%Llist, \%Rlist ] ); @complement = get_complement( [ \%Llist, \%Rlist ] ); and so forth. To compare three or more lists simultaneously, provide the appropriate List::Compare::Functional function with a first array reference holding a list of three or more references to seen-hashes. Thus, @union = get_intersection( [ \%Alpha, \%Beta, \%Gamma ] ); The 'single hashref' format for List::Compare::Functional functions is also available when passing seen-hashes as arguments. Examples: @intersection = get_intersection( { lists => [ \%Alpha, \%Beta, \%Gamma ], } ); @Ronly = get_complement( { lists => [ \%Alpha, \%Beta, \%Gamma ], item => 3, } ); $LR = is_LsubsetR( { lists => [ \%Alpha, \%Beta, \%Gamma ], pair => [ 4, 2 ], } ); $memb_hash_ref = are_members_any( { lists => [ \%Alpha, \%Beta, \%Gamma ], items => [ qw| abel baker fargo hilton zebra | ], } ); =head2 Faster Results with the Unsorted Option By default, List::Compare::Function functions return lists sorted in Perl's default ASCII-betical mode. Sorting entails a performance cost, and if you do not need a sorted list and do not wish to pay this performance cost, you may call the following List::Compare::Function functions with the 'unsorted' option: @intersection = get_intersection( '-u', [ \@Llist, \@Rlist ] ); @union = get_union( '-u', [ \@Llist, \@Rlist ] ); @Lonly = get_unique( '-u', [ \@Llist, \@Rlist ] ); @Ronly = get_complement( '-u', [ \@Llist, \@Rlist ] ); @LorRonly = get_symmetric_difference('-u', [ \@Llist, \@Rlist ] ); @bag = get_bag( '-u', [ \@Llist, \@Rlist ] ); For greater readability, the option may be spelled out: @intersection = get_intersection('--unsorted', [ \@Llist, \@Rlist ] ); or @intersection = get_intersection( { unsorted => 1, lists => [ \@Llist, \@Rlist ], } ); Should you need a reference to an unsorted list as the return value, you may call the unsorted option as follows: $intersection_ref = get_intersection_ref( '-u', [ \@Llist, \@Rlist ] ); $intersection_ref = get_intersection_ref( '--unsorted', [ \@Llist, \@Rlist ] ); =head1 DISCUSSION =head2 General Comments List::Compare::Functional is a non-object-oriented implementation of very common Perl code used to determine interesting relationships between two or more lists at a time. List::Compare::Functional is based on the same author's List::Compare module found in the same CPAN distribution. List::Compare::Functional is closely modeled on the ''Accelerated'' mode in List::Compare. For a discussion of the antecedents of this module, see the discussion of the history and development of this module in the documentation to List::Compare. =head2 List::Compare::Functional's Export Tag Groups By default, List::Compare::Functional exports no functions. You may import individual functions into your main package but may find it more convenient to import via export tag groups. Four such groups are currently defined: use List::Compare::Functional qw(:main) use List::Compare::Functional qw(:mainrefs) use List::Compare::Functional qw(:originals) use List::Compare::Functional qw(:aliases) =over 4 =item * Tag group C<:main> includes what, in the author's opinion, are the six List::Compare::Functional subroutines mostly likely to be used: get_intersection() get_union() get_unique() get_complement() get_symmetric_difference() is_LsubsetR() =item * Tag group C<:mainrefs> includes five of the six subroutines found in C<:main> -- all except C -- in the form in which they return references to arrays rather than arrays proper: get_intersection_ref() get_union_ref() get_unique_ref() get_complement_ref() get_symmetric_difference_ref() =item * Tag group C<:originals> includes all List::Compare::Functional subroutines in their 'original' form, I, no aliases for those subroutines: get_intersection get_intersection_ref get_union get_union_ref get_unique get_unique_ref get_unique_all get_complement get_complement_ref get_complement_all get_symmetric_difference get_symmetric_difference_ref get_shared get_shared_ref get_nonintersection get_nonintersection_ref is_LsubsetR is_RsubsetL is_LequivalentR is_LdisjointR is_member_which is_member_which_ref are_members_which is_member_any are_members_any print_subset_chart print_equivalence_chart get_bag get_bag_ref =item * Tag group C<:aliases> contains all List::Compare::Functional subroutines which are aliases for subroutines found in tag group C<:originals>. These are provided simply for less typing. get_symdiff get_symdiff_ref is_LeqvlntR =back =head2 April 2004 Change of Interface B You can skip this section unless you used List::Compare::Functional prior to the release of Version 0.25 in April 2004. Version 0.25 initiated a significant change in the interface to this module's various functions. In order to be able to accommodate comparisons among more than two lists, it was necessary to change the type of arguments passed to the various functions. Whereas previously a typical List::Compare::Functional function would be called like this: @intersection = get_intersection( \@Llist, \@Rlist ); # SUPERSEDED ... now the references to the lists being compared must now be placed within a wrapper array (anonymous or named), a reference to which is now passed to the function, like so: @intersection = get_intersection( [ \@Llist, \@Rlist ] ); ... or, alternatively: @to_be_compared = (\@Llist, \@Rlist); @intersection = get_intersection( \@to_be_compared ); In a similar manner, List::Compare::Functional functions could previously take arguments in the form of references to 'seen-hashes' instead of references to arrays: @intersection = get_intersection( \%h0, \%h1 ); (See above for discussion of seen-hashes.) Now, those references to seen-hashes must be placed within a wrapper array (anonymous or named), a reference to which is passed to the function, like so: @intersection = get_intersection( [ \%h0, \%h1 ] ); Also, in a similar manner, some List::Compare::Functional functions previously took arguments in addition to the lists being compared. These arguments were simply passed as scalars, like this: @memb_arr = is_member_which(\@Llist, \@Rlist, 'abel'); Now these arguments must also be placed within a wrapper array (anonymous or named), a reference to which is now passed to the function, like so: @memb_arr = is_member_which( [ \@Llist, \@Rlist ], [ 'abel' ] ); ... or, alternatively: @to_be_compared = (\@Llist, \@Rlist); @opts = ( 'abel' ); @memb_arr = is_member_which( \@to_be_compared, \@opts ); As in previous versions, for a speed boost the user may provide the C<'-u'> or C<'--unsorted'> option as the I argument to some List::Compare::Functional functions. Using this option, the C function above would appear as: @intersection = get_intersection( '-u', [ \@Llist, \@Rlist ] ); ... or, alternatively: @intersection = get_intersection( '--unsorted', [ \@Llist, \@Rlist ] ); The arguments to I List::Compare::Functional function will therefore consist possibly of the unsorted option, and then of either one or two references to arrays, the first of which is a reference to an array of arrays or an array of seen-hashes. =head1 AUTHOR James E. Keenan (jkeenan@cpan.org). When sending correspondence, please include 'List::Compare::Functional' or 'List-Compare-Functional' in your subject line. Creation date: May 20, 2002. Last modification date: June 07 2015. Copyright (c) 2002-15 James E. Keenan. United States. All rights reserved. This is free software and may be distributed under the same terms as Perl itself. =cut List-Compare-0.53/lib/List/Compare/Base/0000755000175000017500000000000012535073324017475 5ustar jkeenanjkeenanList-Compare-0.53/lib/List/Compare/Base/_Engine.pm0000644000175000017500000000453112535072713021403 0ustar jkeenanjkeenanpackage List::Compare::Base::_Engine; $VERSION = 0.53; # Holds subroutines used within # List::Compare::Base::Accelerated and List::Compare::Functional use Carp; use List::Compare::Base::_Auxiliary qw( _equiv_engine _calculate_union_seen_only _calculate_seen_only ); @ISA = qw(Exporter); @EXPORT_OK = qw| _unique_all_engine _complement_all_engine |; use strict; local $^W = 1; sub _unique_all_engine { my $aref = shift; my $seenref = _calculate_seen_only($aref); my @all_uniques = (); for my $i (sort {$a <=> $b} keys %{$seenref}) { my %seen_in_all_others = (); for my $j (keys %{$seenref}) { unless ($i == $j) { for my $k (keys %{$seenref->{$j}}) { $seen_in_all_others{$k}++; } } } my @these_uniques = (); for my $l (keys %{$seenref->{$i}}) { push @these_uniques, $l unless $seen_in_all_others{$l}; } $all_uniques[$i] = \@these_uniques; } return \@all_uniques; } sub _complement_all_engine { my ($aref, $unsortflag) = @_; my ($unionref, $seenref) = _calculate_union_seen_only($aref); my @union = $unsortflag ? keys %{$unionref} : sort(keys %{$unionref}); # Calculate @xcomplement # Inputs: $aref @union %seen my (@xcomplement); for (my $i = 0; $i <= $#{$aref}; $i++) { my @complementthis = (); foreach my $el (@union) { push(@complementthis, $el) unless (exists $seenref->{$i}->{$el}); } $xcomplement[$i] = \@complementthis; } return \@xcomplement; } 1; __END__ =head1 NAME List::Compare::Base::_Engine - Internal use only =head1 VERSION This document refers to version 0.53 of List::Compare::Base::_Engine. This version was released June 07 2015. =head1 SYNOPSIS This module contains subroutines used within List::Compare and List::Compare::Functional. They are not intended to be publicly callable. =head1 AUTHOR James E. Keenan (jkeenan@cpan.org). When sending correspondence, please include 'List::Compare' or 'List-Compare' in your subject line. Creation date: May 20, 2002. Last modification date: June 07 2015. Copyright (c) 2002-15 James E. Keenan. United States. All rights reserved. This is free software and may be distributed under the same terms as Perl itself. =cut List-Compare-0.53/lib/List/Compare/Base/_Auxiliary.pm0000644000175000017500000005405012535072713022146 0ustar jkeenanjkeenanpackage List::Compare::Base::_Auxiliary; $VERSION = 0.53; use Carp; @ISA = qw(Exporter); @EXPORT_OK = qw| _validate_2_seenhashes _validate_seen_hash _validate_multiple_seenhashes _calculate_array_seen_only _calculate_seen_only _calculate_intermediate _calculate_union_only _calculate_union_seen_only _calculate_sharedref _subset_subengine _chart_engine_regular _chart_engine_multiple _equivalent_subengine _index_message1 _index_message2 _index_message3 _index_message4 _prepare_listrefs _subset_engine_multaccel _calc_seen _calc_seen1 _equiv_engine _argument_checker_0 _argument_checker _argument_checker_1 _argument_checker_2 _argument_checker_3 _argument_checker_3a _argument_checker_4 _alt_construct_tester _alt_construct_tester_1 _alt_construct_tester_2 _alt_construct_tester_3 _alt_construct_tester_4 _alt_construct_tester_5 |; %EXPORT_TAGS = ( calculate => [ qw( _calculate_array_seen_only _calculate_seen_only _calculate_intermediate _calculate_union_only _calculate_union_seen_only _calculate_sharedref ) ], checker => [ qw( _argument_checker_0 _argument_checker _argument_checker_1 _argument_checker_2 _argument_checker_3 _argument_checker_3a _argument_checker_4 ) ], tester => [ qw( _alt_construct_tester _alt_construct_tester_1 _alt_construct_tester_2 _alt_construct_tester_3 _alt_construct_tester_4 _alt_construct_tester_5 ) ], ); use strict; local $^W =1; my $bad_lists_msg = q{If argument is single hash ref, you must have a 'lists' key whose value is an array ref}; sub _validate_2_seenhashes { my ($refL, $refR) = @_; my (%seenL, %seenR); my (%badentriesL, %badentriesR); foreach (keys %$refL) { if (${$refL}{$_} =~ /^\d+$/ and ${$refL}{$_} > 0) { $seenL{$_} = ${$refL}{$_}; } else { $badentriesL{$_} = ${$refL}{$_}; } } foreach (keys %$refR) { if (${$refR}{$_} =~ /^\d+$/ and ${$refR}{$_} > 0) { $seenR{$_} = ${$refR}{$_}; } else { $badentriesR{$_} = ${$refR}{$_}; } } my $msg = q{}; if ( (keys %badentriesL) or (keys %badentriesR) ) { $msg .= "\nValues in a 'seen-hash' may only be positive integers.\n"; $msg .= " These elements have invalid values:\n"; if (keys %badentriesL) { $msg .= " First hash in arguments:\n"; $msg .= " Key: $_\tValue: $badentriesL{$_}\n" foreach (sort keys %badentriesL); } if (keys %badentriesR) { $msg .= " Second hash in arguments:\n"; $msg .= " Key: $_\tValue: $badentriesR{$_}\n" foreach (sort keys %badentriesR); } $msg .= "Correct invalid values before proceeding"; croak "$msg: $!"; } return (\%seenL, \%seenR); } sub _validate_seen_hash { if (@_ > 2) { _validate_multiple_seenhashes( [@_] ); } else { my ($l, $r) = @_; my (%badentriesL, %badentriesR); foreach (keys %$l) { $badentriesL{$_} = ${$l}{$_} unless (${$l}{$_} =~ /^\d+$/ and ${$l}{$_} > 0); } foreach (keys %$r) { $badentriesR{$_} = ${$r}{$_} unless (${$r}{$_} =~ /^\d+$/ and ${$r}{$_} > 0); } my $msg = q{}; if ( (keys %badentriesL) or (keys %badentriesR) ) { $msg .= "\nValues in a 'seen-hash' must be numeric.\n"; $msg .= " These elements have invalid values:\n"; if (keys %badentriesL) { $msg .= " First hash in arguments:\n"; $msg .= " Key: $_\tValue: $badentriesL{$_}\n" foreach (sort keys %badentriesL); } if (keys %badentriesR) { $msg .= " Second hash in arguments:\n"; $msg .= " Key: $_\tValue: $badentriesR{$_}\n" foreach (sort keys %badentriesR); } $msg .= "Correct invalid values before proceeding"; croak "$msg: $!"; } } } sub _validate_multiple_seenhashes { my $hashrefsref = shift; my (%badentries); for (my $i = 0; $i <= $#{$hashrefsref}; $i++) { foreach my $k (keys %{$hashrefsref->[$i]}) { unless ($hashrefsref->[$i]->{$k} =~ /^\d+$/ and $hashrefsref->[$i]->{$k} > 0) { $badentries{$i}{$k} = $hashrefsref->[$i]->{$k}; } } } my $msg = q{}; if (scalar(keys %badentries)) { $msg .= "\nValues in a 'seen-hash' must be positive integers.\n"; $msg .= " These elements have invalid values:\n\n"; foreach my $b (sort keys %badentries) { $msg .= " Hash $b:\n"; foreach my $val (sort keys %{$badentries{$b}}) { $msg .= " Bad key-value pair: $val\t$badentries{$b}->{$val}\n"; } } $msg .= "Correct invalid values before proceeding"; croak "$msg: $!"; } } sub _list_builder { my ($aref, $x) = @_; if (ref(${$aref}[$x]) eq 'HASH') { return keys %{${$aref}[$x]}; } else { return @{${$aref}[$x]}; } } sub _calculate_array_seen_only { my $aref = shift; my (@seen); for (my $i = 0; $i <= $#{$aref}; $i++) { my %seenthis = (); foreach my $el ( _list_builder($aref, $i) ) { $seenthis{$el}++; } push @seen, \%seenthis; } return \@seen; } sub _calculate_seen_only { my $aref = shift; my (%seen); for (my $i = 0; $i <= $#{$aref}; $i++) { my %seenthis = (); foreach my $h ( _list_builder($aref, $i) ) { $seenthis{$h}++; } $seen{$i} = \%seenthis; } return \%seen; } sub _calculate_intermediate { my $aref = shift; my $aseenref = _calculate_array_seen_only($aref); my @vals = sort { scalar(keys(%{$a})) <=> scalar(keys(%{$b})) } @{$aseenref}; my %intermediate = map { $_ => 1 } keys %{$vals[0]}; for my $l ( 1..$#vals ) { %intermediate = map { $_ => 1 } grep { exists $intermediate{$_} } keys %{$vals[$l]}; } return \%intermediate; } sub _calculate_union_only { my $aref = shift; my (%union); for (my $i = 0; $i <= $#{$aref}; $i++) { foreach my $h ( _list_builder($aref, $i) ) { $union{$h}++; } } return \%union; } sub _calculate_union_seen_only { my $aref = shift; my (%union, %seen); for (my $i = 0; $i <= $#{$aref}; $i++) { my %seenthis = (); foreach my $h ( _list_builder($aref, $i) ) { $seenthis{$h}++; $union{$h}++; } $seen{$i} = \%seenthis; } return (\%union, \%seen); } sub _calculate_sharedref { my $seenrefsref = shift; my %intermediate = (); for my $href (@{$seenrefsref}) { my %this = map { $_ => 1 } keys(%{$href}); for my $k (keys %this) {; $intermediate{$k}++; }; } my $sharedref; for my $k (keys %intermediate) { $sharedref->{$k}++ if $intermediate{$k} > 1; } return $sharedref; } sub _is_list_subset { my ( $subset, $superset ) = @_; # return false if the superset value is false # for any subset value. # note that this does *not* validate overlap of # the keys; it validates the truth of supserset # values. $superset->{ $_ } or return 0 for keys %$subset; return 1; } sub _subset_subengine { my $aref = shift; my (@xsubset); my %seen = %{_calculate_seen_only($aref)}; foreach my $i (keys %seen) { foreach my $j (keys %seen) { if ( $i eq $j ) { $xsubset[$i][$j] = 1; } elsif ( $i gt $j ) { if ( scalar(keys %{ $seen{$i} }) == scalar(keys %{ $seen{$j} }) ){ $xsubset[$i][$j] = _is_list_subset($seen{$i}, $seen{$j}); $xsubset[$j][$i] = $xsubset[$i][$j]; } elsif ( scalar(keys %{ $seen{$i} }) < scalar(keys %{ $seen{$j} }) ){ $xsubset[$i][$j] = _is_list_subset($seen{$i}, $seen{$j}); $xsubset[$j][$i] = 0; } elsif ( scalar(keys %{ $seen{$i} }) > scalar(keys %{ $seen{$j} }) ){ $xsubset[$j][$i] = _is_list_subset($seen{$j}, $seen{$i}); $xsubset[$i][$j] = 0; } } } } return \@xsubset; } sub _chart_engine_regular { my $aref = shift; my @sub_or_eqv = @$aref; my $title = shift; my ($v, $w, $t); print "\n"; print $title, ' Relationships', "\n\n"; print ' Right: 0 1', "\n\n"; print 'Left: 0: 1 ', $sub_or_eqv[0], "\n\n"; print ' 1: ', $sub_or_eqv[1], ' 1', "\n\n"; } sub _chart_engine_multiple { my $aref = shift; my @sub_or_eqv = @$aref; my $title = shift; my ($v, $w, $t); print "\n"; print $title, ' Relationships', "\n\n"; print ' Right:'; for ($v = 0; $v <= $#sub_or_eqv; $v++) { print ' ', $v; } print "\n\n"; print 'Left: 0:'; my @firstrow = @{$sub_or_eqv[0]}; for ($t = 0; $t <= $#firstrow; $t++) { print ' ', $firstrow[$t]; } print "\n\n"; for ($w = 1; $w <= $#sub_or_eqv; $w++) { my $length_left = length($w); my $x = ''; print ' ' x (8 - $length_left), $w, ':'; my @row = @{$sub_or_eqv[$w]}; for ($x = 0; $x <= $#row; $x++) { print ' ', $row[$x]; } print "\n\n"; } 1; # force return true value } sub _equivalent_subengine { my $aref = shift; my @xsubset = @{_subset_subengine($aref)}; my (@xequivalent); for (my $f = 0; $f <= $#xsubset; $f++) { for (my $g = 0; $g <= $#xsubset; $g++) { $xequivalent[$f][$g] = 0; $xequivalent[$f][$g] = 1 if ($xsubset[$f][$g] and $xsubset[$g][$f]); } } return \@xequivalent; } sub _index_message1 { my ($index, $dataref) = @_; my $method = (caller(1))[3]; croak "Argument to method $method must be the array index of the target list \n in list of arrays passed as arguments to the constructor: $!" unless ( $index =~ /^\d+$/ and $index <= ${$dataref}{'maxindex'} ); } sub _index_message2 { my $dataref = shift; my ($index_left, $index_right); my $method = (caller(1))[3]; croak "Method $method requires 2 arguments: $!" unless (@_ == 0 || @_ == 2); if (@_ == 0) { $index_left = 0; $index_right = 1; } else { ($index_left, $index_right) = @_; foreach ($index_left, $index_right) { croak "Each argument to method $method must be a valid array index for the target list \n in list of arrays passed as arguments to the constructor: $!" unless ( $_ =~ /^\d+$/ and $_ <= ${$dataref}{'maxindex'} ); } } return ($index_left, $index_right); } sub _index_message3 { my ($index, $maxindex) = @_; my $method = (caller(1))[3]; croak "Argument to method $method must be the array index of the target list \n in list of arrays passed as arguments to the constructor: $!" unless ( $index =~ /^\d+$/ and $index <= $maxindex ); } sub _index_message4 { my $maxindex = shift; my ($index_left, $index_right); my $method = (caller(1))[3]; croak "Method $method requires 2 arguments: $!" unless (@_ == 0 || @_ == 2); if (@_ == 0) { $index_left = 0; $index_right = 1; } else { ($index_left, $index_right) = @_; foreach ($index_left, $index_right) { croak "Each argument to method $method must be a valid array index for the target list \n in list of arrays passed as arguments to the constructor: $!" unless ( $_ =~ /^\d+$/ and $_ <= $maxindex ); } } return ($index_left, $index_right); } sub _prepare_listrefs { my $dataref = shift; delete ${$dataref}{'unsort'}; my (@listrefs); foreach my $lref (sort {$a <=> $b} keys %{$dataref}) { push(@listrefs, ${$dataref}{$lref}); }; return \@listrefs; } sub _subset_engine_multaccel { my $dataref = shift; my $aref = _prepare_listrefs($dataref); my ($index_left, $index_right) = _index_message4($#{$aref}, @_); my $xsubsetref = _subset_subengine($aref); return ${$xsubsetref}[$index_left][$index_right]; } sub _calc_seen { my ($refL, $refR) = @_; # We've already guaranteed that args are both array refs or both hash # refs. So checking the left-hand one is sufficient. if (ref($refL) eq 'ARRAY') { my (%seenL, %seenR); foreach (@$refL) { $seenL{$_}++ } foreach (@$refR) { $seenR{$_}++ } return (\%seenL, \%seenR); } else { return ($refL, $refR); } } sub _equiv_engine { my ($hrefL, $hrefR) = @_; my (%intersection, %Lonly, %Ronly, %LorRonly); my $LequivalentR_status = 0; foreach (keys %{$hrefL}) { exists ${$hrefR}{$_} ? $intersection{$_}++ : $Lonly{$_}++; } foreach (keys %{$hrefR}) { $Ronly{$_}++ unless (exists $intersection{$_}); } $LorRonly{$_}++ foreach ( (keys %Lonly), (keys %Ronly) ); $LequivalentR_status = 1 if ( (keys %LorRonly) == 0); return $LequivalentR_status; } sub _argument_checker_0 { my @args = @_; my $first_ref = ref($args[0]); my @temp = @args[1..$#args]; my ($testing); my $condition = 1; while (defined ($testing = shift(@temp)) ) { unless (ref($testing) eq $first_ref) { $condition = 0; last; } } croak "Arguments must be either all array references or all hash references: $!" unless $condition; _validate_seen_hash(@args) if $first_ref eq 'HASH'; return (@args); } sub _argument_checker { my $argref = shift; croak "'$argref' must be an array ref" unless ref($argref) eq 'ARRAY'; my @args = _argument_checker_0(@{$argref}); return (@args); } sub _argument_checker_1 { my $argref = shift; my @args = @{$argref}; croak "Subroutine call requires 2 references as arguments: $!" unless @args == 2; return (_argument_checker($args[0]), ${$args[1]}[0]); } sub _argument_checker_2 { my $argref = shift; my @args = @$argref; croak "Subroutine call requires 2 references as arguments: $!" unless @args == 2; return (_argument_checker($args[0]), $args[1]); } # _argument_checker_3 is currently set-up to handle either 1 or 2 arguments # in get_unique and get_complement # The first argument is an arrayref holding refs to lists ('unsorted' has been # stripped off). # The second argument is an arrayref holding a single item (index number of # item being tested) # Note: Currently we're only checking for the quantity of arguments -- not # their types. This should be fixed. sub _argument_checker_3 { my $argref = shift; my @args = @{$argref}; if (@args == 1) { return (_argument_checker($args[0]), 0); } elsif (@args == 2) { return (_argument_checker($args[0]), ${$args[1]}[0]); } else { croak "Subroutine call requires 1 or 2 references as arguments: $!"; } } sub _argument_checker_3a { my $argref = shift; my @args = @{$argref}; if (@args == 1) { return [ _argument_checker($args[0]) ]; } else { croak "Subroutine call requires exactly 1 reference as argument: $!"; } } sub _argument_checker_4 { my $argref = shift; my @args = @{$argref}; if (@args == 1) { return (_argument_checker($args[0]), [0,1]); } elsif (@args == 2) { if (@{$args[1]} == 2) { my $last_index = $#{$args[0]}; foreach my $i (@{$args[1]}) { croak "No element in index position $i in list of list references passed as first argument to function: $!" unless ($i =~ /^\d+$/ and $i <= $last_index); } return (_argument_checker($args[0]), $args[1]); } else { croak "Must provide index positions corresponding to two lists: $!"; } } else { croak "Subroutine call requires 1 or 2 references as arguments: $!"; } } sub _calc_seen1 { my @listrefs = @_; # _calc_seen1() is applied after _argument_checker(), which checks to make # sure that the references in its output are either all arrayrefs # or all seenhashrefs # hence, _calc_seen1 only needs to determine whether it's dealing with # arrayrefs or seenhashrefs, then, if arrayrefs, calculate seenhashes if (ref($listrefs[0]) eq 'ARRAY') { my (@seenrefs); foreach my $aref (@listrefs) { my (%seenthis); foreach my $j (@{$aref}) { $seenthis{$j}++; } push(@seenrefs, \%seenthis); } return \@seenrefs; } else { return \@listrefs; } } # _alt_construct_tester prepares for _argument_checker in # get_union get_intersection get_symmetric_difference get_shared get_nonintersection sub _alt_construct_tester { my @args = @_; my ($argref, $unsorted); if (@args == 1 and (ref($args[0]) eq 'HASH')) { my $hashref = shift; croak "$bad_lists_msg: $!" unless ( ${$hashref}{'lists'} and (ref(${$hashref}{'lists'}) eq 'ARRAY') ); $argref = ${$hashref}{'lists'}; $unsorted = ${$hashref}{'unsorted'} ? 1 : ''; } else { $unsorted = shift(@args) if ($args[0] eq '-u' or $args[0] eq '--unsorted'); $argref = shift(@args); } return ($argref, $unsorted); } # _alt_construct_tester_1 prepares for _argument_checker_1 in # is_member_which is_member_which_ref is_member_any sub _alt_construct_tester_1 { my @args = @_; my ($argref); if (@args == 1 and (ref($args[0]) eq 'HASH')) { my (@returns); my $hashref = $args[0]; croak "$bad_lists_msg: $!" unless ( ${$hashref}{'lists'} and (ref(${$hashref}{'lists'}) eq 'ARRAY') ); croak "If argument is single hash ref, you must have an 'item' key: $!" unless ${$hashref}{'item'}; @returns = ( ${$hashref}{'lists'}, [${$hashref}{'item'}] ); $argref = \@returns; } else { $argref = \@args; } return $argref; } # _alt_construct_tester_2 prepares for _argument_checker_2 in # are_members_which are_members_any sub _alt_construct_tester_2 { my @args = @_; if (@args == 1 and (ref($args[0]) eq 'HASH')) { my $hashref = $args[0]; croak "$bad_lists_msg: $!" unless ( ${$hashref}{'lists'} and (ref(${$hashref}{'lists'}) eq 'ARRAY') ); croak "If argument is single hash ref, you must have an 'items' key whose value is an array ref: $!" unless ( ${$hashref}{'items'} and (ref(${$hashref}{'items'}) eq 'ARRAY') ); return [ (${$hashref}{'lists'}, ${$hashref}{'items'}) ]; } else { return \@args; } } # _alt_construct_tester_3 prepares for _argument_checker_3 in # get_unique get_complement sub _alt_construct_tester_3 { my @args = @_; my ($argref, $unsorted); if (@args == 1 and (ref($args[0]) eq 'HASH')) { my (@returns); my $hashref = $args[0]; croak "$bad_lists_msg: $!" unless ( ${$hashref}{'lists'} and (ref(${$hashref}{'lists'}) eq 'ARRAY') ); @returns = defined ${$hashref}{'item'} ? (${$hashref}{'lists'}, [${$hashref}{'item'}]) : (${$hashref}{'lists'}); $argref = \@returns; $unsorted = ${$hashref}{'unsorted'} ? 1 : ''; } else { $unsorted = shift(@args) if ($args[0] eq '-u' or $args[0] eq '--unsorted'); $argref = \@args; } return ($argref, $unsorted); } # _alt_construct_tester_4 prepares for _argument_checker_4 in # is_LsubsetR is_RsubsetL is_LequivalentR is_LdisjointR sub _alt_construct_tester_4 { my @args = @_; my ($argref); if (@args == 1 and (ref($args[0]) eq 'HASH')) { my (@returns); my $hashref = $args[0]; croak "$bad_lists_msg: $!" unless ( ${$hashref}{'lists'} and (ref(${$hashref}{'lists'}) eq 'ARRAY') ); @returns = defined ${$hashref}{'pair'} ? (${$hashref}{'lists'}, ${$hashref}{'pair'}) : (${$hashref}{'lists'}); $argref = \@returns; } else { $argref = \@args; } return $argref; } # _alt_construct_tester_5 prepares for _argument_checker in # print_subset_chart print_equivalence_chart sub _alt_construct_tester_5 { my @args = @_; my ($argref); if (@args == 1) { if (ref($args[0]) eq 'HASH') { my $hashref = shift; croak "Need to define 'lists' key properly: $!" unless ( ${$hashref}{'lists'} and (ref(${$hashref}{'lists'}) eq 'ARRAY') ); $argref = ${$hashref}{'lists'}; } else { $argref = shift(@args); } } else { croak "Subroutine call requires exactly 1 reference as argument: $!"; } return $argref; } 1; __END__ =head1 NAME List::Compare::Base::_Auxiliary - Internal use only =head1 VERSION This document refers to version 0.53 of List::Compare::Base::_Auxiliary. This version was released June 07 2015. =head1 SYNOPSIS This module contains subroutines used within List::Compare and List::Compare::Functional. They are not intended to be publicly callable. =head1 AUTHOR James E. Keenan (jkeenan@cpan.org). When sending correspondence, please include 'List::Compare' or 'List-Compare' in your subject line. Creation date: May 20, 2002. Last modification date: February 25 2015. Copyright (c) 2002-15 James E. Keenan. United States. All rights reserved. This is free software and may be distributed under the same terms as Perl itself. =cut List-Compare-0.53/lib/List/Compare.pm0000644000175000017500000032057312535072713017174 0ustar jkeenanjkeenanpackage List::Compare; $VERSION = '0.53'; use strict; local $^W = 1; use Carp; use List::Compare::Base::_Auxiliary qw( _validate_2_seenhashes _chart_engine_regular ); sub new { my $class = shift; my (@args, $unsorted, $accelerated); my ($argument_error_status, $nextarg, @testargs); if (@_ == 1 and (ref($_[0]) eq 'HASH')) { my $argref = shift; die "Need to pass references to 2 or more seen-hashes or \n to provide a 'lists' key within the single hash being passed by reference" unless exists ${$argref}{'lists'}; die "Need to define 'lists' key properly: $!" unless ( ${$argref}{'lists'} and (ref(${$argref}{'lists'}) eq 'ARRAY') ); @args = @{${$argref}{'lists'}}; $unsorted = ${$argref}{'unsorted'} ? 1 : ''; $accelerated = ${$argref}{'accelerated'} ? 1 : ''; } else { @args = @_; $unsorted = ($args[0] eq '-u' or $args[0] eq '--unsorted') ? shift(@args) : ''; $accelerated = shift(@args) if ($args[0] eq '-a' or $args[0] eq '--accelerated'); } $argument_error_status = 1; @testargs = @args[1..$#args]; if (ref($args[0]) eq 'ARRAY' or ref($args[0]) eq 'HASH') { while (defined ($nextarg = shift(@testargs))) { unless (ref($nextarg) eq ref($args[0])) { $argument_error_status = 0; last; } } } else { $argument_error_status = 0; } croak "Must pass all array references or all hash references: $!" unless $argument_error_status; # Compose the name of the class if (@args > 2) { if ($accelerated) { $class .= '::Multiple::Accelerated'; } else { $class .= '::Multiple'; } } elsif (@args == 2) { if ($accelerated) { $class .= '::Accelerated'; } } else { croak "Must pass at least 2 references to \&new: $!"; } # do necessary calculations and store results in a hash # take a reference to that hash my $self = bless {}, $class; my $dataref = $self->_init(($unsorted ? 1 : 0), @args); # initialize the object from the prepared values (Damian, p. 98) %$self = %$dataref; return $self; } sub _init { my $self = shift; my ($unsortflag, $refL, $refR) = @_; my (%data, @left, @right, %seenL, %seenR); if (ref($refL) eq 'HASH') { my ($seenLref, $seenRref) = _validate_2_seenhashes($refL, $refR); foreach my $key (keys %{$seenLref}) { for (my $j=1; $j <= ${$seenLref}{$key}; $j++) { push(@left, $key); } } foreach my $key (keys %{$seenRref}) { for (my $j=1; $j <= ${$seenRref}{$key}; $j++) { push(@right, $key); } } %seenL = %{$seenLref}; %seenR = %{$seenRref}; } else { foreach (@$refL) { $seenL{$_}++ } foreach (@$refR) { $seenR{$_}++ } @left = @$refL; @right = @$refR; } my @bag = $unsortflag ? (@left, @right) : sort(@left, @right); my (%intersection, %union, %Lonly, %Ronly, %LorRonly); my $LsubsetR_status = my $RsubsetL_status = 1; my $LequivalentR_status = 0; foreach (keys %seenL) { $union{$_}++; exists $seenR{$_} ? $intersection{$_}++ : $Lonly{$_}++; } foreach (keys %seenR) { $union{$_}++; $Ronly{$_}++ unless (exists $intersection{$_}); } $LorRonly{$_}++ foreach ( (keys %Lonly), (keys %Ronly) ); $LequivalentR_status = 1 if ( (keys %LorRonly) == 0); foreach (@left) { if (! exists $seenR{$_}) { $LsubsetR_status = 0; last; } } foreach (@right) { if (! exists $seenL{$_}) { $RsubsetL_status = 0; last; } } $data{'seenL'} = \%seenL; $data{'seenR'} = \%seenR; $data{'intersection'} = $unsortflag ? [ keys %intersection ] : [ sort keys %intersection ]; $data{'union'} = $unsortflag ? [ keys %union ] : [ sort keys %union ]; $data{'unique'} = $unsortflag ? [ keys %Lonly ] : [ sort keys %Lonly ]; $data{'complement'} = $unsortflag ? [ keys %Ronly ] : [ sort keys %Ronly ]; $data{'symmetric_difference'} = $unsortflag ? [ keys %LorRonly ] : [ sort keys %LorRonly ]; $data{'LsubsetR_status'} = $LsubsetR_status; $data{'RsubsetL_status'} = $RsubsetL_status; $data{'LequivalentR_status'} = $LequivalentR_status; $data{'LdisjointR_status'} = keys %intersection == 0 ? 1 : 0; $data{'bag'} = \@bag; return \%data; } sub get_intersection { return @{ get_intersection_ref(shift) }; } sub get_intersection_ref { my $class = shift; my %data = %$class; return $data{'intersection'}; } sub get_union { return @{ get_union_ref(shift) }; } sub get_union_ref { my $class = shift; my %data = %$class; return $data{'union'}; } sub get_shared { my $class = shift; my $method = (caller(0))[3]; carp "When comparing only 2 lists, $method defaults to \n ", 'get_intersection()', ". Though the results returned are valid, \n please consider re-coding with that method: $!"; get_intersection($class); } sub get_shared_ref { my $class = shift; my $method = (caller(0))[3]; carp "When comparing only 2 lists, $method defaults to \n ", 'get_intersection_ref()', ". Though the results returned are valid, \n please consider re-coding with that method: $!"; get_intersection_ref($class); } sub get_unique { return @{ get_unique_ref(shift) }; } sub get_unique_ref { my $class = shift; my %data = %$class; return $data{'unique'}; } sub get_unique_all { my $class = shift; my %data = %$class; return [ $data{'unique'}, $data{'complement'} ]; } *get_Lonly = \&get_unique; *get_Aonly = \&get_unique; *get_Lonly_ref = \&get_unique_ref; *get_Aonly_ref = \&get_unique_ref; sub get_complement { return @{ get_complement_ref(shift) }; } sub get_complement_ref { my $class = shift; my %data = %$class; return $data{'complement'}; } sub get_complement_all { my $class = shift; my %data = %$class; return [ $data{'complement'}, $data{'unique'} ]; } *get_Ronly = \&get_complement; *get_Bonly = \&get_complement; *get_Ronly_ref = \&get_complement_ref; *get_Bonly_ref = \&get_complement_ref; sub get_symmetric_difference { return @{ get_symmetric_difference_ref(shift) }; } sub get_symmetric_difference_ref { my $class = shift; my %data = %$class; return $data{'symmetric_difference'}; } *get_symdiff = \&get_symmetric_difference; *get_LorRonly = \&get_symmetric_difference; *get_AorBonly = \&get_symmetric_difference; *get_symdiff_ref = \&get_symmetric_difference_ref; *get_LorRonly_ref = \&get_symmetric_difference_ref; *get_AorBonly_ref = \&get_symmetric_difference_ref; sub get_nonintersection { my $class = shift; my $method = (caller(0))[3]; carp "When comparing only 2 lists, $method defaults to \n ", 'get_symmetric_difference()', ". Though the results returned are valid, \n please consider re-coding with that method: $!"; get_symmetric_difference($class); } sub get_nonintersection_ref { my $class = shift; my $method = (caller(0))[3]; carp "When comparing only 2 lists, $method defaults to \n ", 'get_symmetric_difference_ref()', ". Though the results returned are valid, \n please consider re-coding with that method: $!"; get_symmetric_difference_ref($class); } sub is_LsubsetR { my $class = shift; my %data = %$class; return $data{'LsubsetR_status'}; } *is_AsubsetB = \&is_LsubsetR; sub is_RsubsetL { my $class = shift; my %data = %$class; return $data{'RsubsetL_status'}; } *is_BsubsetA = \&is_RsubsetL; sub is_LequivalentR { my $class = shift; my %data = %$class; return $data{'LequivalentR_status'}; } *is_LeqvlntR = \&is_LequivalentR; sub is_LdisjointR { my $class = shift; my %data = %$class; return $data{'LdisjointR_status'}; } sub print_subset_chart { my $class = shift; my %data = %$class; my @subset_array = ($data{'LsubsetR_status'}, $data{'RsubsetL_status'}); my $title = 'Subset'; _chart_engine_regular(\@subset_array, $title); } sub print_equivalence_chart { my $class = shift; my %data = %$class; my @equivalent_array = ($data{'LequivalentR_status'}, $data{'LequivalentR_status'}); my $title = 'Equivalence'; _chart_engine_regular(\@equivalent_array, $title); } sub is_member_which { return @{ is_member_which_ref(@_) }; } sub is_member_which_ref { my $class = shift; croak "Method call requires exactly 1 argument (no references): $!" unless (@_ == 1 and ref($_[0]) ne 'ARRAY'); my %data = %$class; my ($arg, @found); $arg = shift; if (exists ${$data{'seenL'}}{$arg}) { push @found, 0; } if (exists ${$data{'seenR'}}{$arg}) { push @found, 1; } if ( (! exists ${$data{'seenL'}}{$arg}) && (! exists ${$data{'seenR'}}{$arg}) ) { @found = (); } return \@found; } sub are_members_which { my $class = shift; croak "Method call requires exactly 1 argument which must be an array reference\n holding the items to be tested: $!" unless (@_ == 1 and ref($_[0]) eq 'ARRAY'); my %data = %$class; my (@args, %found); @args = @{$_[0]}; for (my $i=0; $i<=$#args; $i++) { if (exists ${$data{'seenL'}}{$args[$i]}) { push @{$found{$args[$i]}}, 0; } if (exists ${$data{'seenR'}}{$args[$i]}) { push @{$found{$args[$i]}}, 1; } if ( (! exists ${$data{'seenL'}}{$args[$i]}) && (! exists ${$data{'seenR'}}{$args[$i]}) ) { @{$found{$args[$i]}} = (); } } return \%found; } sub is_member_any { my $class = shift; croak "Method call requires exactly 1 argument (no references): $!" unless (@_ == 1 and ref($_[0]) ne 'ARRAY'); my %data = %$class; my $arg = shift; ( defined $data{'seenL'}{$arg} ) || ( defined $data{'seenR'}{$arg} ) ? return 1 : return 0; } sub are_members_any { my $class = shift; croak "Method call requires exactly 1 argument which must be an array reference\n holding the items to be tested: $!" unless (@_ == 1 and ref($_[0]) eq 'ARRAY'); my %data = %$class; my (@args, %present); @args = @{$_[0]}; for (my $i=0; $i<=$#args; $i++) { $present{$args[$i]} = ( defined $data{'seenL'}{$args[$i]} ) || ( defined $data{'seenR'}{$args[$i]} ) ? 1 : 0; } return \%present; } sub get_bag { return @{ get_bag_ref(shift) }; } sub get_bag_ref { my $class = shift; my %data = %$class; return $data{'bag'}; } sub get_version { return $List::Compare::VERSION; } 1; ################################################################################ package List::Compare::Accelerated; use Carp; use List::Compare::Base::_Auxiliary qw( _argument_checker_0 _chart_engine_regular _calc_seen _equiv_engine ); sub _init { my $self = shift; my ($unsortflag, $refL, $refR) = @_; my %data = (); ($data{'L'}, $data{'R'}) = _argument_checker_0($refL, $refR); $data{'unsort'} = $unsortflag ? 1 : 0; return \%data; } sub get_intersection { return @{ get_intersection_ref(shift) }; } sub get_intersection_ref { my $class = shift; my %data = %$class; $data{'unsort'} ? return _intersection_engine($data{'L'}, $data{'R'}) : return [ sort @{_intersection_engine($data{'L'}, $data{'R'})} ]; } sub get_union { return @{ get_union_ref(shift) }; } sub get_union_ref { my $class = shift; my %data = %$class; $data{'unsort'} ? return _union_engine($data{'L'}, $data{'R'}) : return [ sort @{_union_engine($data{'L'}, $data{'R'})} ]; } sub get_shared { return @{ get_shared_ref(shift) }; } sub get_shared_ref { my $class = shift; my $method = (caller(0))[3]; $method =~ s/.*::(\w*)$/$1/; carp "When comparing only 2 lists, \&$method defaults to \n \&get_union_ref. Though the results returned are valid, \n please consider re-coding with that method: $!"; &get_union_ref($class); } sub get_unique { return @{ get_unique_ref(shift) }; } sub get_unique_ref { my $class = shift; my %data = %$class; $data{'unsort'} ? return _unique_engine($data{'L'}, $data{'R'}) : return [ sort @{_unique_engine($data{'L'}, $data{'R'})} ]; } sub get_unique_all { my $class = shift; return [ get_unique_ref($class), get_complement_ref($class) ]; } *get_Lonly = \&get_unique; *get_Aonly = \&get_unique; *get_Lonly_ref = \&get_unique_ref; *get_Aonly_ref = \&get_unique_ref; sub get_complement { return @{ get_complement_ref(shift) }; } sub get_complement_ref { my $class = shift; my %data = %$class; $data{'unsort'} ? return _complement_engine($data{'L'}, $data{'R'}) : return [ sort @{_complement_engine($data{'L'}, $data{'R'})} ]; } sub get_complement_all { my $class = shift; return [ get_complement_ref($class), get_unique_ref($class) ]; } *get_Ronly = \&get_complement; *get_Bonly = \&get_complement; *get_Ronly_ref = \&get_complement_ref; *get_Bonly_ref = \&get_complement_ref; sub get_symmetric_difference { return @{ get_symmetric_difference_ref(shift) }; } sub get_symmetric_difference_ref { my $class = shift; my %data = %$class; $data{'unsort'} ? return _symmetric_difference_engine($data{'L'}, $data{'R'}) : return [ sort @{_symmetric_difference_engine($data{'L'}, $data{'R'})} ]; } *get_symdiff = \&get_symmetric_difference; *get_LorRonly = \&get_symmetric_difference; *get_AorBonly = \&get_symmetric_difference; *get_symdiff_ref = \&get_symmetric_difference_ref; *get_LorRonly_ref = \&get_symmetric_difference_ref; *get_AorBonly_ref = \&get_symmetric_difference_ref; sub get_nonintersection { return @{ get_nonintersection_ref(shift) }; } sub get_nonintersection_ref { my $class = shift; my $method = (caller(0))[3]; $method =~ s/.*::(\w*)$/$1/; carp "When comparing only 2 lists, \&$method defaults to \n \&get_symmetric_difference_ref. Though the results returned are valid, \n please consider re-coding with that method: $!"; &get_symmetric_difference_ref($class); } sub is_LsubsetR { my $class = shift; my %data = %$class; return _is_LsubsetR_engine($data{'L'}, $data{'R'}); } *is_AsubsetB = \&is_LsubsetR; sub is_RsubsetL { my $class = shift; my %data = %$class; return _is_RsubsetL_engine($data{'L'}, $data{'R'}); } *is_BsubsetA = \&is_RsubsetL; sub is_LequivalentR { my $class = shift; my %data = %$class; return _is_LequivalentR_engine($data{'L'}, $data{'R'}); } *is_LeqvlntR = \&is_LequivalentR; sub is_LdisjointR { my $class = shift; my %data = %$class; return _is_LdisjointR_engine($data{'L'}, $data{'R'}); } sub print_subset_chart { my $class = shift; my %data = %$class; _print_subset_chart_engine($data{'L'}, $data{'R'}); } sub print_equivalence_chart { my $class = shift; my %data = %$class; _print_equivalence_chart_engine($data{'L'}, $data{'R'}); } sub is_member_which { return @{ is_member_which_ref(@_) }; } sub is_member_which_ref { my $class = shift; croak "Method call requires exactly 1 argument (no references): $!" unless (@_ == 1 and ref($_[0]) ne 'ARRAY'); my %data = %$class; return _is_member_which_engine($data{'L'}, $data{'R'}, shift); } sub are_members_which { my $class = shift; croak "Method call requires exactly 1 argument which must be an array reference\n holding the items to be tested: $!" unless (@_ == 1 and ref($_[0]) eq 'ARRAY'); my %data = %$class; my (@args); @args = @{$_[0]}; return _are_members_which_engine($data{'L'}, $data{'R'}, \@args); } sub is_member_any { my $class = shift; croak "Method call requires exactly 1 argument (no references): $!" unless (@_ == 1 and ref($_[0]) ne 'ARRAY'); my %data = %$class; return _is_member_any_engine($data{'L'}, $data{'R'}, shift); } sub are_members_any { my $class = shift; croak "Method call requires exactly 1 argument which must be an array reference\n holding the items to be tested: $!" unless (@_ == 1 and ref($_[0]) eq 'ARRAY'); my %data = %$class; my (@args); @args = @{$_[0]}; return _are_members_any_engine($data{'L'}, $data{'R'}, \@args); } sub get_bag { return @{ get_bag_ref(shift) }; } sub get_bag_ref { my $class = shift; my %data = %$class; if (ref($data{'L'}) eq 'ARRAY') { $data{'unsort'} ? return [ @{$data{'L'}}, @{$data{'R'}} ] : return [ sort(@{$data{'L'}}, @{$data{'R'}}) ]; } else { my (@left, @right); foreach my $key (keys %{$data{'L'}}) { for (my $j=1; $j <= ${$data{'L'}}{$key}; $j++) { push(@left, $key); } } foreach my $key (keys %{$data{'R'}}) { for (my $j=1; $j <= ${$data{'R'}}{$key}; $j++) { push(@right, $key); } } $data{'unsort'} ? return [ @left, @right ] : return [ sort(@left, @right) ]; } } sub get_version { return $List::Compare::VERSION; } sub _intersection_engine { my ($l, $r) = @_; my ($hrefL, $hrefR) = _calc_seen($l, $r); my %intersection = (); foreach (keys %{$hrefL}) { $intersection{$_}++ if (exists ${$hrefR}{$_}); } return [ keys %intersection ]; } sub _union_engine { my ($l, $r) = @_; my ($hrefL, $hrefR) = _calc_seen($l, $r); my %union = (); $union{$_}++ foreach ( (keys %{$hrefL}), (keys %{$hrefR}) ); return [ keys %union ]; } sub _unique_engine { my ($l, $r) = @_; my ($hrefL, $hrefR) = _calc_seen($l, $r); my (%Lonly); foreach (keys %{$hrefL}) { $Lonly{$_}++ unless exists ${$hrefR}{$_}; } return [ keys %Lonly ]; } sub _complement_engine { my ($l, $r) = @_; my ($hrefL, $hrefR) = _calc_seen($l, $r); my (%Ronly); foreach (keys %{$hrefR}) { $Ronly{$_}++ unless (exists ${$hrefL}{$_}); } return [ keys %Ronly ]; } sub _symmetric_difference_engine { my ($l, $r) = @_; my ($hrefL, $hrefR) = _calc_seen($l, $r); my (%LorRonly); foreach (keys %{$hrefL}) { $LorRonly{$_}++ unless (exists ${$hrefR}{$_}); } foreach (keys %{$hrefR}) { $LorRonly{$_}++ unless (exists ${$hrefL}{$_}); } return [ keys %LorRonly ]; } sub _is_LsubsetR_engine { my ($l, $r) = @_; my ($hrefL, $hrefR) = _calc_seen($l, $r); my $LsubsetR_status = 1; foreach (keys %{$hrefL}) { if (! exists ${$hrefR}{$_}) { $LsubsetR_status = 0; last; } } return $LsubsetR_status; } sub _is_RsubsetL_engine { my ($l, $r) = @_; my ($hrefL, $hrefR) = _calc_seen($l, $r); my $RsubsetL_status = 1; foreach (keys %{$hrefR}) { if (! exists ${$hrefL}{$_}) { $RsubsetL_status = 0; last; } } return $RsubsetL_status; } sub _is_LequivalentR_engine { my ($l, $r) = @_; my ($hrefL, $hrefR) = _calc_seen($l, $r); return _equiv_engine($hrefL, $hrefR); } sub _is_LdisjointR_engine { my ($l, $r) = @_; my ($hrefL, $hrefR) = _calc_seen($l, $r); my %intersection = (); foreach (keys %{$hrefL}) { $intersection{$_}++ if (exists ${$hrefR}{$_}); } keys %intersection == 0 ? 1 : 0; } sub _print_subset_chart_engine { my ($l, $r) = @_; my ($hrefL, $hrefR) = _calc_seen($l, $r); my $LsubsetR_status = my $RsubsetL_status = 1; foreach (keys %{$hrefL}) { if (! exists ${$hrefR}{$_}) { $LsubsetR_status = 0; last; } } foreach (keys %{$hrefR}) { if (! exists ${$hrefL}{$_}) { $RsubsetL_status = 0; last; } } my @subset_array = ($LsubsetR_status, $RsubsetL_status); my $title = 'Subset'; _chart_engine_regular(\@subset_array, $title); } sub _print_equivalence_chart_engine { my ($l, $r) = @_; my ($hrefL, $hrefR) = _calc_seen($l, $r); my $LequivalentR_status = _equiv_engine($hrefL, $hrefR); my @equivalent_array = ($LequivalentR_status, $LequivalentR_status); my $title = 'Equivalence'; _chart_engine_regular(\@equivalent_array, $title); } sub _is_member_which_engine { my ($l, $r, $arg) = @_; my ($hrefL, $hrefR) = _calc_seen($l, $r); my (@found); if (exists ${$hrefL}{$arg}) { push @found, 0; } if (exists ${$hrefR}{$arg}) { push @found, 1; } if ( (! exists ${$hrefL}{$arg}) && (! exists ${$hrefR}{$arg}) ) { @found = (); } return \@found; } sub _are_members_which_engine { my ($l, $r, $arg) = @_; my ($hrefL, $hrefR) = _calc_seen($l, $r); my @args = @{$arg}; my (%found); for (my $i=0; $i<=$#args; $i++) { if (exists ${$hrefL}{$args[$i]}) { push @{$found{$args[$i]}}, 0; } if (exists ${$hrefR}{$args[$i]}) { push @{$found{$args[$i]}}, 1; } if ( (! exists ${$hrefL}{$args[$i]}) && (! exists ${$hrefR}{$args[$i]}) ) { @{$found{$args[$i]}} = (); } } return \%found; } sub _is_member_any_engine { my ($l, $r, $arg) = @_; my ($hrefL, $hrefR) = _calc_seen($l, $r); ( defined ${$hrefL}{$arg} ) || ( defined ${$hrefR}{$arg} ) ? return 1 : return 0; } sub _are_members_any_engine { my ($l, $r, $arg) = @_; my ($hrefL, $hrefR) = _calc_seen($l, $r); my @args = @{$arg}; my (%present); for (my $i=0; $i<=$#args; $i++) { $present{$args[$i]} = ( defined ${$hrefL}{$args[$i]} ) || ( defined ${$hrefR}{$args[$i]} ) ? 1 : 0; } return \%present; } 1; ################################################################################ package List::Compare::Multiple; use Carp; use List::Compare::Base::_Auxiliary qw( _validate_seen_hash _index_message1 _index_message2 _chart_engine_multiple ); sub _init { my $self = shift; my $unsortflag = shift; my @listrefs = @_; my (@arrayrefs); my $maxindex = $#listrefs; if (ref($listrefs[0]) eq 'ARRAY') { @arrayrefs = @listrefs; } else { _validate_seen_hash(@listrefs); foreach my $href (@listrefs) { my (@temp); foreach my $key (keys %{$href}) { for (my $j=1; $j <= ${$href}{$key}; $j++) { push(@temp, $key); } } push(@arrayrefs, \@temp); } } my @bag = (); foreach my $aref (@arrayrefs) { push @bag, $_ foreach @$aref; } @bag = sort(@bag) unless $unsortflag; my (@intersection, @union); # will hold overall intersection/union my @nonintersection = (); # will hold all items except those found in each source list # @intersection + @nonintersection = @union my @shared = (); # will hold all items found in at least 2 lists my @symmetric_difference = (); # will hold each item found in only one list regardless of list; # equivalent to @union minus all items found in the lists # underlying %xintersection my (%intersection, %union); # will be used to generate @intersection & @union my %seen = (); # will be hash of hashes, holding seen-hashes corresponding to # the source lists my %xintersection = (); # will be hash of hashes, holding seen-hashes corresponding to # the lists containing the intersections of each permutation of # the source lists my %shared = (); # will be used to generate @shared my @xunique = (); # will be array of arrays, holding the items that are unique to # the list whose index number is passed as an argument my @xcomplement = (); # will be array of arrays, holding the items that are found in # any list other than the list whose index number is passed # as an argument my @xdisjoint = (); # will be an array of arrays, holding an indicator as to whether # any pair of lists are disjoint, i.e., have no intersection # Calculate overall union and take steps needed to calculate overall # intersection, unique, difference, etc. for (my $i = 0; $i <= $#arrayrefs; $i++) { my %seenthis = (); foreach (@{$arrayrefs[$i]}) { $seenthis{$_}++; $union{$_}++; } $seen{$i} = \%seenthis; for (my $j = $i+1; $j <=$#arrayrefs; $j++) { my (%seenthat, %seenintersect); my $ilabel = $i . '_' . $j; $seenthat{$_}++ foreach (@{$arrayrefs[$j]}); foreach (keys %seenthat) { $seenintersect{$_}++ if (exists $seenthis{$_}); } $xintersection{$ilabel} = \%seenintersect; } } @union = $unsortflag ? keys %union : sort(keys %union); # At this point we now have %seen, @union and %xintersection available # for use in other calculations. # Calculate overall intersection # Inputs: %xintersection my @xkeys = keys %xintersection; %intersection = %{$xintersection{$xkeys[0]}}; for (my $m = 1; $m <= $#xkeys; $m++) { my %compare = %{$xintersection{$xkeys[$m]}}; my %result = (); foreach (keys %compare) { $result{$_}++ if (exists $intersection{$_}); } %intersection = %result; } @intersection = $unsortflag ? keys %intersection : sort(keys %intersection); # Calculate nonintersection # Inputs: @union %intersection foreach (@union) { push(@nonintersection, $_) unless (exists $intersection{$_}); } # Calculate @xunique and @xdisjoint # Inputs: @arrayrefs %seen %xintersection for (my $i = 0; $i <= $#arrayrefs; $i++) { my %seenthis = %{$seen{$i}}; my (@uniquethis, %deductions, %alldeductions); # Get those elements of %xintersection which we'll need # to subtract from %seenthis foreach (keys %xintersection) { my ($left, $right) = split /_/, $_; if ($left == $i || $right == $i) { $deductions{$_} = $xintersection{$_}; } $xdisjoint[$left][$right] = $xdisjoint[$right][$left] = ! (keys %{$xintersection{$_}}) ? 1 : 0; } foreach my $ded (keys %deductions) { foreach (keys %{$deductions{$ded}}) { $alldeductions{$_}++; } } foreach (keys %seenthis) { push(@uniquethis, $_) unless ($alldeductions{$_}); } $xunique[$i] = \@uniquethis; $xdisjoint[$i][$i] = 0; } # @xunique is now available for use in further calculations, # such as returning the items unique to a particular source list. # Calculate @xcomplement # Inputs: @arrayrefs %seen @union for (my $i = 0; $i <= $#arrayrefs; $i++) { my %seenthis = %{$seen{$i}}; my @complementthis = (); foreach (@union) { push(@complementthis, $_) unless (exists $seenthis{$_}); } $xcomplement[$i] = \@complementthis; } # @xcomplement is now available for use in further calculations, # such as returning the items in all lists different from those in a # particular source list. # Calculate @shared and @symmetric_difference # Inputs: %xintersection @union foreach my $q (keys %xintersection) { $shared{$_}++ foreach (keys %{$xintersection{$q}}); } @shared = $unsortflag ? keys %shared : sort(keys %shared); foreach (@union) { push(@symmetric_difference, $_) unless (exists $shared{$_}); } # @shared and @symmetric_difference are now available. my @xsubset = (); foreach my $i (keys %seen) { my %tempi = %{$seen{$i}}; foreach my $j (keys %seen) { my %tempj = %{$seen{$j}}; $xsubset[$i][$j] = 1; foreach (keys %tempi) { $xsubset[$i][$j] = 0 if (! $tempj{$_}); } } } # @xsubset is now available my @xequivalent = (); for (my $f = 0; $f <= $#xsubset; $f++) { for (my $g = 0; $g <= $#xsubset; $g++) { $xequivalent[$f][$g] = 0; $xequivalent[$f][$g] = 1 if ($xsubset[$f][$g] and $xsubset[$g][$f]); } } my (%data); $data{'seen'} = \%seen; $data{'maxindex'} = $maxindex; $data{'intersection'} = \@intersection; $data{'nonintersection'} = \@nonintersection; $data{'union'} = \@union; $data{'shared'} = \@shared; $data{'symmetric_difference'} = \@symmetric_difference; $data{'xunique'} = \@xunique; $data{'xcomplement'} = \@xcomplement; $data{'xsubset'} = \@xsubset; $data{'xequivalent'} = \@xequivalent; $data{'xdisjoint'} = \@xdisjoint; $data{'bag'} = \@bag; return \%data; } sub get_intersection { return @{ get_intersection_ref(shift) }; } sub get_intersection_ref { my $class = shift; my %data = %$class; return $data{'intersection'}; } sub get_union { return @{ get_union_ref(shift) }; } sub get_union_ref { my $class = shift; my %data = %$class; return $data{'union'}; } sub get_shared { return @{ get_shared_ref(shift) }; } sub get_shared_ref { my $class = shift; my %data = %$class; return $data{'shared'}; } sub get_unique { my $class = shift; my %data = %$class; my $index = defined $_[0] ? shift : 0; return @{ get_unique_ref($class, $index) }; } sub get_unique_ref { my $class = shift; my %data = %$class; my $index = defined $_[0] ? shift : 0; _index_message1($index, \%data); return ${$data{'xunique'}}[$index]; } sub get_unique_all { my $class = shift; my %data = %$class; return $data{'xunique'}; } sub get_Lonly { my ($class, $index) = @_; my $method = (caller(0))[3]; $method =~ s/.*::(\w*)$/$1/; carp "When comparing 3 or more lists, \&$method or its alias defaults to \n ", 'get_unique()', ". Though the results returned are valid, \n please consider re-coding with that method: $!"; get_unique($class, $index); } sub get_Lonly_ref { my ($class, $index) = @_; my $method = (caller(0))[3]; $method =~ s/.*::(\w*)$/$1/; carp "When comparing 3 or more lists, \&$method or its alias defaults to \n ", 'get_unique_ref()', ". Though the results returned are valid, \n please consider re-coding with that method: $!"; get_unique_ref($class, $index); } *get_Aonly = \&get_Lonly; *get_Aonly_ref = \&get_Lonly_ref; sub get_complement { my $class = shift; my %data = %$class; my $index = defined $_[0] ? shift : 0; return @{ get_complement_ref($class, $index) }; } sub get_complement_ref { my $class = shift; my %data = %$class; my $index = defined $_[0] ? shift : 0; _index_message1($index, \%data); return ${$data{'xcomplement'}}[$index]; } sub get_complement_all { my $class = shift; my %data = %$class; return $data{'xcomplement'}; } sub get_Ronly { my ($class, $index) = @_; my $method = (caller(0))[3]; $method =~ s/.*::(\w*)$/$1/; carp "When comparing 3 or more lists, \&$method or its alias defaults to \n ", 'get_complement()', ". Though the results returned are valid, \n please consider re-coding with that method: $!"; &get_complement($class, $index); } sub get_Ronly_ref { my ($class, $index) = @_; my $method = (caller(0))[3]; $method =~ s/.*::(\w*)$/$1/; carp "When comparing 3 or more lists, \&$method or its alias defaults to \n ", 'get_complement_ref()', ". Though the results returned are valid, \n please consider re-coding with that method: $!"; &get_complement_ref($class, $index); } *get_Bonly = \&get_Ronly; *get_Bonly_ref = \&get_Ronly_ref; sub get_symmetric_difference { return @{ get_symmetric_difference_ref(shift) }; } sub get_symmetric_difference_ref { my $class = shift; my %data = %$class; return $data{'symmetric_difference'}; } *get_symdiff = \&get_symmetric_difference; *get_symdiff_ref = \&get_symmetric_difference_ref; sub get_LorRonly { my $class = shift; my $method = (caller(0))[3]; $method =~ s/.*::(\w*)$/$1/; carp "When comparing 3 or more lists, \&$method or its alias defaults to \n ", 'get_symmetric_difference()', ". Though the results returned are valid, \n please consider re-coding with that method: $!"; get_symmetric_difference($class); } sub get_LorRonly_ref { my $class = shift; my $method = (caller(0))[3]; $method =~ s/.*::(\w*)$/$1/; carp "When comparing 3 or more lists, \&$method or its alias defaults to \n ", 'get_symmetric_difference_ref()', ". Though the results returned are valid, \n please consider re-coding with that method: $!"; get_symmetric_difference_ref($class); } *get_AorBonly = \&get_LorRonly; *get_AorBonly_ref = \&get_LorRonly_ref; sub get_nonintersection { return @{ get_nonintersection_ref(shift) }; } sub get_nonintersection_ref { my $class = shift; my %data = %$class; return $data{'nonintersection'}; } sub is_LsubsetR { my $class = shift; my %data = %$class; my ($index_left, $index_right) = _index_message2(\%data, @_); my @subset_array = @{$data{'xsubset'}}; my $subset_status = $subset_array[$index_left][$index_right]; return $subset_status; } *is_AsubsetB = \&is_LsubsetR; sub is_RsubsetL { my $class = shift; my %data = %$class; my $method = (caller(0))[3]; $method =~ s/.*::(\w*)$/$1/; carp "When comparing 3 or more lists, \&$method or its alias is restricted to \n asking if the list which is the 2nd argument to the constructor \n is a subset of the list which is the 1st argument.\n For greater flexibility, please re-code with \&is_LsubsetR: $!"; @_ = (1,0); my ($index_left, $index_right) = _index_message2(\%data, @_); my @subset_array = @{$data{'xsubset'}}; my $subset_status = $subset_array[$index_left][$index_right]; return $subset_status; } *is_BsubsetA = \&is_RsubsetL; sub is_LequivalentR { my $class = shift; my %data = %$class; my ($index_left, $index_right) = _index_message2(\%data, @_); my @equivalent_array = @{$data{'xequivalent'}}; my $equivalent_status = $equivalent_array[$index_left][$index_right]; return $equivalent_status; } *is_LeqvlntR = \&is_LequivalentR; sub is_LdisjointR { my $class = shift; my %data = %$class; my ($index_left, $index_right) = _index_message2(\%data, @_); my @disjoint_array = @{$data{'xdisjoint'}}; my $disjoint_status = $disjoint_array[$index_left][$index_right]; return $disjoint_status; } sub is_member_which { return @{ is_member_which_ref(@_) }; } sub is_member_which_ref { my $class = shift; croak "Method call requires exactly 1 argument (no references): $!" unless (@_ == 1 and ref($_[0]) ne 'ARRAY'); my %data = %$class; my %seen = %{$data{'seen'}}; my ($arg, @found); $arg = shift; foreach (sort keys %seen) { push @found, $_ if (exists $seen{$_}{$arg}); } return \@found; } sub are_members_which { my $class = shift; croak "Method call requires exactly 1 argument which must be an array reference\n holding the items to be tested: $!" unless (@_ == 1 and ref($_[0]) eq 'ARRAY'); my %data = %$class; my %seen = %{$data{'seen'}}; my (@args, %found); @args = @{$_[0]}; for (my $i=0; $i<=$#args; $i++) { my (@not_found); foreach (sort keys %seen) { exists ${$seen{$_}}{$args[$i]} ? push @{$found{$args[$i]}}, $_ : push @not_found, $_; } $found{$args[$i]} = [] if (@not_found == keys %seen); } return \%found; } sub is_member_any { my $class = shift; croak "Method call requires exactly 1 argument (no references): $!" unless (@_ == 1 and ref($_[0]) ne 'ARRAY'); my %data = %$class; my %seen = %{$data{'seen'}}; my ($arg, $k); $arg = shift; while ( $k = each %seen ) { return 1 if (defined $seen{$k}{$arg}); } return 0; } sub are_members_any { my $class = shift; croak "Method call requires exactly 1 argument which must be an array reference\n holding the items to be tested: $!" unless (@_ == 1 and ref($_[0]) eq 'ARRAY'); my %data = %$class; my %seen = %{$data{'seen'}}; my (@args, %present); @args = @{$_[0]}; for (my $i=0; $i<=$#args; $i++) { foreach (keys %seen) { unless (defined $present{$args[$i]}) { $present{$args[$i]} = 1 if $seen{$_}{$args[$i]}; } } $present{$args[$i]} = 0 if (! defined $present{$args[$i]}); } return \%present; } sub print_subset_chart { my $class = shift; my %data = %$class; my @subset_array = @{$data{'xsubset'}}; my $title = 'Subset'; _chart_engine_multiple(\@subset_array, $title); } sub print_equivalence_chart { my $class = shift; my %data = %$class; my @equivalent_array = @{$data{'xequivalent'}}; my $title = 'Equivalence'; _chart_engine_multiple(\@equivalent_array, $title); } sub get_bag { return @{ get_bag_ref(shift) }; } sub get_bag_ref { my $class = shift; my %data = %$class; return $data{'bag'}; } sub get_version { return $List::Compare::VERSION; } 1; ################################################################################ package List::Compare::Multiple::Accelerated; use Carp; use List::Compare::Base::_Auxiliary qw( _argument_checker_0 _prepare_listrefs _subset_subengine _chart_engine_multiple _equivalent_subengine _index_message3 _index_message4 _subset_engine_multaccel ); use List::Compare::Base::_Auxiliary qw(:calculate); use List::Compare::Base::_Engine qw( _unique_all_engine _complement_all_engine ); sub _init { my $self = shift; my $unsortflag = shift; my @listrefs = _argument_checker_0(@_); my %data = (); for (my $i=0; $i<=$#listrefs; $i++) { $data{$i} = $listrefs[$i]; } $data{'unsort'} = $unsortflag ? 1 : 0; return \%data; } sub get_union { return @{ get_union_ref(shift) }; } sub get_union_ref { my $class = shift; my %data = %$class; my $unsortflag = $data{'unsort'}; my $aref = _prepare_listrefs(\%data); my $unionref = _calculate_union_only($aref); my @union = $unsortflag ? keys %{$unionref} : sort(keys %{$unionref}); return \@union; } sub get_intersection { return @{ get_intersection_ref(shift) }; } sub get_intersection_ref { my $class = shift; my %data = %$class; my $unsortflag = $data{'unsort'}; my $aref = _prepare_listrefs(\%data); my $intermediate_ref = _calculate_intermediate($aref); my @intersection = $unsortflag ? keys %{$intermediate_ref} : sort(keys %{$intermediate_ref}); return \@intersection; } sub get_nonintersection { return @{ get_nonintersection_ref(shift) }; } sub get_nonintersection_ref { my $class = shift; my %data = %$class; my $unsortflag = $data{'unsort'}; my $aref = _prepare_listrefs(\%data); my $unionref = _calculate_union_only($aref); my $intermediate_ref = _calculate_intermediate($aref); my (@nonintersection); foreach my $el (keys %{$unionref}) { push(@nonintersection, $el) unless exists $intermediate_ref->{$el}; } return [ $unsortflag ? @nonintersection : sort(@nonintersection) ]; } sub get_shared { return @{ get_shared_ref(shift) }; } sub get_shared_ref { my $class = shift; my %data = %$class; my $unsortflag = $data{'unsort'}; my $aref = _prepare_listrefs(\%data); my $aseenref = _calculate_array_seen_only($aref); my $intermediate = _calculate_sharedref($aseenref); my @shared = $unsortflag ? keys %{$intermediate} : sort(keys %{$intermediate}); return \@shared; } sub get_symmetric_difference { return @{ get_symmetric_difference_ref(shift) }; } sub get_symmetric_difference_ref { my $class = shift; my %data = %$class; my $unsortflag = $data{'unsort'}; my $aref = _prepare_listrefs(\%data); my $unionref = _calculate_union_only($aref); my $aseenref = _calculate_array_seen_only($aref); my $sharedref = _calculate_sharedref($aseenref); my (@symmetric_difference); foreach my $el (keys %{$unionref}) { push(@symmetric_difference, $el) unless exists $sharedref->{$el}; } return [ $unsortflag ? @symmetric_difference : sort(@symmetric_difference) ]; } *get_symdiff = \&get_symmetric_difference; *get_symdiff_ref = \&get_symmetric_difference_ref; sub get_LorRonly { my $class = shift; my $method = (caller(0))[3]; $method =~ s/.*::(\w*)$/$1/; carp "When comparing 3 or more lists, \&$method or its alias defaults to \n ", 'get_symmetric_difference()', ". Though the results returned are valid, \n please consider re-coding with that method: $!"; get_symmetric_difference($class); } sub get_LorRonly_ref { my $class = shift; my $method = (caller(0))[3]; $method =~ s/.*::(\w*)$/$1/; carp "When comparing 3 or more lists, \&$method or its alias defaults to \n ", 'get_symmetric_difference_ref()', ". Though the results returned are valid, \n please consider re-coding with that method: $!"; get_symmetric_difference_ref($class); } *get_AorBonly = \&get_LorRonly; *get_AorBonly_ref = \&get_LorRonly_ref; sub get_unique { my $class = shift; my %data = %$class; my $index = defined $_[0] ? shift : 0; return @{ get_unique_ref($class, $index) }; } sub get_unique_ref { my $class = shift; my %data = %$class; my $index = defined $_[0] ? shift : 0; my $aref = _prepare_listrefs(\%data); _index_message3($index, $#{$aref}); my $unique_all_ref = _unique_all_engine($aref); return ${$unique_all_ref}[$index]; } sub get_unique_all { my $class = shift; my %data = %$class; my $aref = _prepare_listrefs(\%data); return _unique_all_engine($aref); } sub get_Lonly { my ($class, $index) = @_; my $method = (caller(0))[3]; $method =~ s/.*::(\w*)$/$1/; carp "When comparing 3 or more lists, \&$method or its alias defaults to \n ", 'get_unique()', ". Though the results returned are valid, \n please consider re-coding with that method: $!"; get_unique($class, $index); } sub get_Lonly_ref { my ($class, $index) = @_; my $method = (caller(0))[3]; $method =~ s/.*::(\w*)$/$1/; carp "When comparing 3 or more lists, \&$method or its alias defaults to \n ", 'get_unique_ref()', ". Though the results returned are valid, \n please consider re-coding with that method: $!"; get_unique_ref($class, $index); } *get_Aonly = \&get_Lonly; *get_Aonly_ref = \&get_Lonly_ref; sub get_complement { my $class = shift; my %data = %$class; my $index = defined $_[0] ? shift : 0; return @{ get_complement_ref($class, $index) }; } sub get_complement_ref { my $class = shift; my %data = %$class; my $index = defined $_[0] ? shift : 0; my $unsortflag = $data{'unsort'}; my $aref = _prepare_listrefs(\%data); _index_message3($index, $#{$aref}); my $complement_all_ref = _complement_all_engine($aref, $unsortflag ); return ${$complement_all_ref}[$index]; } sub get_complement_all { my $class = shift; my %data = %$class; my $aref = _prepare_listrefs(\%data); return _complement_all_engine($aref); } sub get_Ronly { my ($class, $index) = @_; my $method = (caller(0))[3]; $method =~ s/.*::(\w*)$/$1/; carp "When comparing 3 or more lists, \&$method or its alias defaults to \n ", 'get_complement()', ". Though the results returned are valid, \n please consider re-coding with that method: $!"; &get_complement($class, $index); } sub get_Ronly_ref { my ($class, $index) = @_; my $method = (caller(0))[3]; $method =~ s/.*::(\w*)$/$1/; carp "When comparing 3 or more lists, \&$method or its alias defaults to \n ", 'get_complement_ref()', ". Though the results returned are valid, \n please consider re-coding with that method: $!"; &get_complement_ref($class, $index); } *get_Bonly = \&get_Ronly; *get_Bonly_ref = \&get_Ronly_ref; sub is_LsubsetR { my $class = shift; my %data = %$class; my $subset_status = _subset_engine_multaccel(\%data, @_); return $subset_status; } *is_AsubsetB = \&is_LsubsetR; sub is_RsubsetL { my $class = shift; my %data = %$class; my $method = (caller(0))[3]; $method =~ s/.*::(\w*)$/$1/; carp "When comparing 3 or more lists, \&$method or its alias is restricted to \n asking if the list which is the 2nd argument to the constructor \n is a subset of the list which is the 1st argument.\n For greater flexibility, please re-code with \&is_LsubsetR: $!"; @_ = (1,0); my $subset_status = _subset_engine_multaccel(\%data, @_); return $subset_status; } *is_BsubsetA = \&is_RsubsetL; sub is_LequivalentR { my $class = shift; my %data = %$class; my $aref = _prepare_listrefs(\%data); my ($index_left, $index_right) = _index_message4($#{$aref}, @_); my $xequivalentref = _equivalent_subengine($aref); return ${$xequivalentref}[$index_left][$index_right]; } *is_LeqvlntR = \&is_LequivalentR; sub is_LdisjointR { my $class = shift; my %data = %$class; my $aref = _prepare_listrefs(\%data); my ($index_left, $index_right) = _index_message4($#{$aref}, @_); my $aseenref = _calculate_array_seen_only( [ $aref->[$index_left], $aref->[$index_right] ] ); my $disjoint_status = 1; OUTER: for my $k (keys %{$aseenref->[0]}) { if ($aseenref->[1]->{$k}) { $disjoint_status = 0; last OUTER; } } return $disjoint_status; } sub is_member_which { return @{ is_member_which_ref(@_) }; } sub is_member_which_ref { my $class = shift; croak "Method call requires exactly 1 argument (no references): $!" unless (@_ == 1 and ref($_[0]) ne 'ARRAY'); my %data = %{$class}; my $aref = _prepare_listrefs(\%data); my $seenref = _calculate_seen_only($aref); my ($arg, @found); $arg = shift; foreach (sort keys %{$seenref}) { push @found, $_ if (exists ${$seenref}{$_}{$arg}); } return \@found; } sub are_members_which { my $class = shift; croak "Method call requires exactly 1 argument which must be an array reference\n holding the items to be tested: $!" unless (@_ == 1 and ref($_[0]) eq 'ARRAY'); my %data = %{$class}; my $aref = _prepare_listrefs(\%data); my $seenref = _calculate_seen_only($aref); my (@args, %found); @args = @{$_[0]}; for (my $i=0; $i<=$#args; $i++) { my (@not_found); foreach (sort keys %{$seenref}) { exists ${${$seenref}{$_}}{$args[$i]} ? push @{$found{$args[$i]}}, $_ : push @not_found, $_; } $found{$args[$i]} = [] if (@not_found == keys %{$seenref}); } return \%found; } sub is_member_any { my $class = shift; croak "Method call requires exactly 1 argument (no references): $!" unless (@_ == 1 and ref($_[0]) ne 'ARRAY'); my %data = %$class; my $aref = _prepare_listrefs(\%data); my $seenref = _calculate_seen_only($aref); my ($arg, $k); $arg = shift; while ( $k = each %{$seenref} ) { return 1 if (defined ${$seenref}{$k}{$arg}); } return 0; } sub are_members_any { my $class = shift; croak "Method call requires exactly 1 argument which must be an array reference\n holding the items to be tested: $!" unless (@_ == 1 and ref($_[0]) eq 'ARRAY'); my %data = %$class; my $aref = _prepare_listrefs(\%data); my $seenref = _calculate_seen_only($aref); my (@args, %present); @args = @{$_[0]}; for (my $i=0; $i<=$#args; $i++) { foreach (keys %{$seenref}) { unless (defined $present{$args[$i]}) { $present{$args[$i]} = 1 if ${$seenref}{$_}{$args[$i]}; } } $present{$args[$i]} = 0 if (! defined $present{$args[$i]}); } return \%present; } sub print_subset_chart { my $class = shift; my %data = %$class; my $aref = _prepare_listrefs(\%data); my $xsubsetref = _subset_subengine($aref); my $title = 'Subset'; _chart_engine_multiple($xsubsetref, $title); } sub print_equivalence_chart { my $class = shift; my %data = %$class; my $aref = _prepare_listrefs(\%data); my $xequivalentref = _equivalent_subengine($aref); my $title = 'Equivalence'; _chart_engine_multiple($xequivalentref, $title); } sub get_bag { return @{ get_bag_ref(shift) }; } sub get_bag_ref { my $class = shift; my %data = %$class; my $unsortflag = $data{'unsort'}; my $aref = _prepare_listrefs(\%data); my (@bag); my @listrefs = @{$aref}; if (ref($listrefs[0]) eq 'ARRAY') { foreach my $lref (@listrefs) { foreach my $el (@{$lref}) { push(@bag, $el); } } } else { foreach my $lref (@listrefs) { foreach my $key (keys %{$lref}) { for (my $j=1; $j <= ${$lref}{$key}; $j++) { push(@bag, $key); } } } } @bag = sort(@bag) unless $unsortflag; return \@bag; } sub get_version { return $List::Compare::VERSION; } 1; #################### DOCUMENTATION #################### =head1 NAME List::Compare - Compare elements of two or more lists =head1 VERSION This document refers to version 0.53 of List::Compare. This version was released June 07 2015. =head1 SYNOPSIS The bare essentials: @Llist = qw(abel abel baker camera delta edward fargo golfer); @Rlist = qw(baker camera delta delta edward fargo golfer hilton); $lc = List::Compare->new(\@Llist, \@Rlist); @intersection = $lc->get_intersection; @union = $lc->get_union; ... and so forth. =head1 DISCUSSION: Modes and Methods =head2 Regular Case: Compare Two Lists =over 4 =item * Constructor: C Create a List::Compare object. Put the two lists into arrays (named or anonymous) and pass references to the arrays to the constructor. @Llist = qw(abel abel baker camera delta edward fargo golfer); @Rlist = qw(baker camera delta delta edward fargo golfer hilton); $lc = List::Compare->new(\@Llist, \@Rlist); By default, List::Compare's methods return lists which are sorted using Perl's default C mode: ASCII-betical sorting. Should you not need to have these lists sorted, you may achieve a speed boost by constructing the List::Compare object with the unsorted option: $lc = List::Compare->new('-u', \@Llist, \@Rlist); or $lc = List::Compare->new('--unsorted', \@Llist, \@Rlist); =item * Alternative Constructor If you prefer a more explicit delineation of the types of arguments passed to a function, you may use this 'single hashref' kind of constructor to build a List::Compare object: $lc = List::Compare->new( { lists => [\@Llist, \@Rlist] } ); or $lc = List::Compare->new( { lists => [\@Llist, \@Rlist], unsorted => 1, } ); =item * C Get those items which appear at least once in both lists (their intersection). @intersection = $lc->get_intersection; =item * C Get those items which appear at least once in either list (their union). @union = $lc->get_union; =item * C Get those items which appear (at least once) only in the first list. @Lonly = $lc->get_unique; @Lonly = $lc->get_Lonly; # alias =item * C Get those items which appear (at least once) only in the second list. @Ronly = $lc->get_complement; @Ronly = $lc->get_Ronly; # alias =item * C Get those items which appear at least once in either the first or the second list, but not both. @LorRonly = $lc->get_symmetric_difference; @LorRonly = $lc->get_symdiff; # alias @LorRonly = $lc->get_LorRonly; # alias =item * C Make a bag of all those items in both lists. The bag differs from the union of the two lists in that it holds as many copies of individual elements as appear in the original lists. @bag = $lc->get_bag; =item * Return references rather than lists An alternative approach to the above methods: If you do not immediately require an array as the return value of the method call, but simply need a I to an (anonymous) array, use one of the following parallel methods: $intersection_ref = $lc->get_intersection_ref; $union_ref = $lc->get_union_ref; $Lonly_ref = $lc->get_unique_ref; $Lonly_ref = $lc->get_Lonly_ref; # alias $Ronly_ref = $lc->get_complement_ref; $Ronly_ref = $lc->get_Ronly_ref; # alias $LorRonly_ref = $lc->get_symmetric_difference_ref; $LorRonly_ref = $lc->get_symdiff_ref; # alias $LorRonly_ref = $lc->get_LorRonly_ref; # alias $bag_ref = $lc->get_bag_ref; =item * C Return a true value if the first argument passed to the constructor ('L' for 'left') is a subset of the second argument passed to the constructor ('R' for 'right'). $LR = $lc->is_LsubsetR; Return a true value if R is a subset of L. $RL = $lc->is_RsubsetL; =item * C Return a true value if the two lists passed to the constructor are equivalent, I if every element in the left-hand list ('L') appears at least once in the right-hand list ('R') and I. $eqv = $lc->is_LequivalentR; $eqv = $lc->is_LeqvlntR; # alias =item * C Return a true value if the two lists passed to the constructor are disjoint, I if the two lists have zero elements in common (or, what is the same thing, if their intersection is an empty set). $disj = $lc->is_LdisjointR; =item * C Pretty-print a chart showing whether one list is a subset of the other. $lc->print_subset_chart; =item * C Pretty-print a chart showing whether the two lists are equivalent (same elements found at least once in both). $lc->print_equivalence_chart; =item * C Determine in I (if any) of the lists passed to the constructor a given string can be found. In list context, return a list of those indices in the constructor's argument list corresponding to lists holding the string being tested. @memb_arr = $lc->is_member_which('abel'); In the example above, C<@memb_arr> will be: ( 0 ) because C<'abel'> is found only in C<@Al> which holds position C<0> in the list of arguments passed to C. In scalar context, the return value is the number of lists passed to the constructor in which a given string is found. As with other List::Compare methods which return a list, you may wish the above method returned a (scalar) reference to an array holding the list: $memb_arr_ref = $lc->is_member_which_ref('baker'); In the example above, C<$memb_arr_ref> will be: [ 0, 1 ] because C<'baker'> is found in C<@Llist> and C<@Rlist>, which hold positions C<0> and C<1>, respectively, in the list of arguments passed to C. B methods C and C test only one string at a time and hence take only one argument. To test more than one string at a time see the next method, C. =item * C Determine in I (if any) of the lists passed to the constructor one or more given strings can be found. The strings to be tested are placed in an array (named or anonymous); a reference to that array is passed to the method. $memb_hash_ref = $lc->are_members_which([ qw| abel baker fargo hilton zebra | ]); I In versions of List::Compare prior to 0.25 (April 2004), the strings to be tested could be passed as a flat list. This is no longer possible; the argument must now be a reference to an array. The return value is a reference to a hash of arrays. The key for each element in this hash is the string being tested. Each element's value is a reference to an anonymous array whose elements are those indices in the constructor's argument list corresponding to lists holding the strings being tested. In the examples above, C<$memb_hash_ref> will be: { abel => [ 0 ], baker => [ 0, 1 ], fargo => [ 0, 1 ], hilton => [ 1 ], zebra => [ ], }; B C can take more than one argument; C and C each take only one argument. Unlike those two methods, C returns a hash reference. =item * C Determine whether a given string can be found in I of the lists passed as arguments to the constructor. Return 1 if a specified string can be found in any of the lists and 0 if not. $found = $lc->is_member_any('abel'); In the example above, C<$found> will be C<1> because C<'abel'> is found in one or more of the lists passed as arguments to C. =item * C Determine whether a specified string or strings can be found in I of the lists passed as arguments to the constructor. The strings to be tested are placed in an array (named or anonymous); a reference to that array is passed to C. $memb_hash_ref = $lc->are_members_any([ qw| abel baker fargo hilton zebra | ]); I In versions of List::Compare prior to 0.25 (April 2004), the strings to be tested could be passed as a flat list. This is no longer possible; the argument must now be a reference to an array. The return value is a reference to a hash where an element's key is the string being tested and the element's value is 1 if the string can be found in I of the lists and 0 if not. In the examples above, C<$memb_hash_ref> will be: { abel => 1, baker => 1, fargo => 1, hilton => 1, zebra => 0, }; C's value is C<0> because C is not found in either of the lists passed as arguments to C. =item * C Return current List::Compare version number. $vers = $lc->get_version; =back =head2 Accelerated Case: When User Only Wants a Single Comparison =over 4 =item * Constructor C If you are certain that you will only want the results of a I comparison, computation may be accelerated by passing C<'-a'> or C<'--accelerated> as the first argument to the constructor. @Llist = qw(abel abel baker camera delta edward fargo golfer); @Rlist = qw(baker camera delta delta edward fargo golfer hilton); $lca = List::Compare->new('-a', \@Llist, \@Rlist); or $lca = List::Compare->new('--accelerated', \@Llist, \@Rlist); As with List::Compare's Regular case, should you not need to have a sorted list returned by an accelerated List::Compare method, you may achieve a speed boost by constructing the accelerated List::Compare object with the unsorted option: $lca = List::Compare->new('-u', '-a', \@Llist, \@Rlist); or $lca = List::Compare->new('--unsorted', '--accelerated', \@Llist, \@Rlist); =item * Alternative Constructor You may use the 'single hashref' constructor format to build a List::Compare object calling for the Accelerated mode: $lca = List::Compare->new( { lists => [\@Llist, \@Rlist], accelerated => 1, } ); or $lca = List::Compare->new( { lists => [\@Llist, \@Rlist], accelerated => 1, unsorted => 1, } ); =item * Methods All the comparison methods available in the Regular case are available to you in the Accelerated case as well. @intersection = $lca->get_intersection; @union = $lca->get_union; @Lonly = $lca->get_unique; @Ronly = $lca->get_complement; @LorRonly = $lca->get_symmetric_difference; @bag = $lca->get_bag; $intersection_ref = $lca->get_intersection_ref; $union_ref = $lca->get_union_ref; $Lonly_ref = $lca->get_unique_ref; $Ronly_ref = $lca->get_complement_ref; $LorRonly_ref = $lca->get_symmetric_difference_ref; $bag_ref = $lca->get_bag_ref; $LR = $lca->is_LsubsetR; $RL = $lca->is_RsubsetL; $eqv = $lca->is_LequivalentR; $disj = $lca->is_LdisjointR; $lca->print_subset_chart; $lca->print_equivalence_chart; @memb_arr = $lca->is_member_which('abel'); $memb_arr_ref = $lca->is_member_which_ref('baker'); $memb_hash_ref = $lca->are_members_which( [ qw| abel baker fargo hilton zebra | ]); $found = $lca->is_member_any('abel'); $memb_hash_ref = $lca->are_members_any( [ qw| abel baker fargo hilton zebra | ]); $vers = $lca->get_version; All the aliases for methods available in the Regular case are available to you in the Accelerated case as well. =back =head2 Multiple Case: Compare Three or More Lists =over 4 =item * Constructor C Create a List::Compare object. Put each list into an array and pass references to the arrays to the constructor. @Al = qw(abel abel baker camera delta edward fargo golfer); @Bob = qw(baker camera delta delta edward fargo golfer hilton); @Carmen = qw(fargo golfer hilton icon icon jerky kappa); @Don = qw(fargo icon jerky); @Ed = qw(fargo icon icon jerky); $lcm = List::Compare->new(\@Al, \@Bob, \@Carmen, \@Don, \@Ed); As with List::Compare's Regular case, should you not need to have a sorted list returned by a List::Compare method, you may achieve a speed boost by constructing the object with the unsorted option: $lcm = List::Compare->new('-u', \@Al, \@Bob, \@Carmen, \@Don, \@Ed); or $lcm = List::Compare->new('--unsorted', \@Al, \@Bob, \@Carmen, \@Don, \@Ed); =item * Alternative Constructor You may use the 'single hashref' constructor format to build a List::Compare object to process three or more lists at once: $lcm = List::Compare->new( { lists => [\@Al, \@Bob, \@Carmen, \@Don, \@Ed], } ); or $lcm = List::Compare->new( { lists => [\@Al, \@Bob, \@Carmen, \@Don, \@Ed], unsorted => 1, } ); =item * Multiple Mode Methods Analogous to Regular and Accelerated Mode Methods Each List::Compare method available in the Regular and Accelerated cases has an analogue in the Multiple case. However, the results produced usually require more careful specification. B Certain of the following methods available in List::Compare's Multiple mode take optional numerical arguments where those numbers represent the index position of a particular list in the list of arguments passed to the constructor. To specify this index position correctly, =over 4 =item * start the count at C<0> (as is customary with Perl array indices); and =item * do I count any unsorted option (C<'-u'> or C<'--unsorted'>) preceding the array references in the constructor's own argument list. =back Example: $lcmex = List::Compare->new('--unsorted', \@alpha, \@beta, \@gamma); For the purpose of supplying a numerical argument to a method which optionally takes such an argument, C<'--unsorted'> is skipped, C<@alpha> is C<0>, C<@beta> is C<1>, and so forth. =over 4 =item * C Get those items found in I of the lists passed to the constructor (their intersection): @intersection = $lcm->get_intersection; =item * C Get those items found in I of the lists passed to the constructor (their union): @union = $lcm->get_union; =item * C To get those items which appear only in I provide C with that list's index position in the list of arguments passed to the constructor (not counting any C<'-u'> or C<'--unsorted'> option). Example: C<@Carmen> has index position C<2> in the constructor's C<@_>. To get elements unique to C<@Carmen>: @Lonly = $lcm->get_unique(2); If no index position is passed to C it will default to 0 and report items unique to the first list passed to the constructor. =item * C To get those items which appear in any list I provide C with that list's index position in the list of arguments passed to the constructor (not counting any C<'-u'> or C<'--unsorted'> option). Example: C<@Don> has index position C<3> in the constructor's C<@_>. To get elements not found in C<@Don>: @Ronly = $lcm->get_complement(3); If no index position is passed to C it will default to 0 and report items found in any list other than the first list passed to the constructor. =item * C Get those items each of which appears in I of the lists passed to the constructor (their symmetric_difference); @LorRonly = $lcm->get_symmetric_difference; =item * C Make a bag of all items found in any list. The bag differs from the lists' union in that it holds as many copies of individual elements as appear in the original lists. @bag = $lcm->get_bag; =item * Return reference instead of list An alternative approach to the above methods: If you do not immediately require an array as the return value of the method call, but simply need a I to an array, use one of the following parallel methods: $intersection_ref = $lcm->get_intersection_ref; $union_ref = $lcm->get_union_ref; $Lonly_ref = $lcm->get_unique_ref(2); $Ronly_ref = $lcm->get_complement_ref(3); $LorRonly_ref = $lcm->get_symmetric_difference_ref; $bag_ref = $lcm->get_bag_ref; =item * C To determine whether one particular list is a subset of another list passed to the constructor, provide C with the index position of the presumed subset (ignoring any unsorted option), followed by the index position of the presumed superset. Example: To determine whether C<@Ed> is a subset of C<@Carmen>, call: $LR = $lcm->is_LsubsetR(4,2); A true value (C<1>) is returned if the left-hand list is a subset of the right-hand list; a false value (C<0>) is returned otherwise. If no arguments are passed, C defaults to C<(0,1)> and compares the first two lists passed to the constructor. =item * C To determine whether any two particular lists are equivalent to each other, provide C with their index positions in the list of arguments passed to the constructor (ignoring any unsorted option). Example: To determine whether C<@Don> and C<@Ed> are equivalent, call: $eqv = $lcm->is_LequivalentR(3,4); A true value (C<1>) is returned if the lists are equivalent; a false value (C<0>) otherwise. If no arguments are passed, C defaults to C<(0,1)> and compares the first two lists passed to the constructor. =item * C To determine whether any two particular lists are disjoint from each other (I have no members in common), provide C with their index positions in the list of arguments passed to the constructor (ignoring any unsorted option). Example: To determine whether C<@Don> and C<@Ed> are disjoint, call: $disj = $lcm->is_LdisjointR(3,4); A true value (C<1>) is returned if the lists are equivalent; a false value (C<0>) otherwise. If no arguments are passed, C defaults to C<(0,1)> and compares the first two lists passed to the constructor. =item * C Pretty-print a chart showing the subset relationships among the various source lists: $lcm->print_subset_chart; =item * C Pretty-print a chart showing the equivalence relationships among the various source lists: $lcm->print_equivalence_chart; =item * C Determine in I (if any) of the lists passed to the constructor a given string can be found. In list context, return a list of those indices in the constructor's argument list (ignoring any unsorted option) corresponding to i lists holding the string being tested. @memb_arr = $lcm->is_member_which('abel'); In the example above, C<@memb_arr> will be: ( 0 ) because C<'abel'> is found only in C<@Al> which holds position C<0> in the list of arguments passed to C. =item * C As with other List::Compare methods which return a list, you may wish the above method returned a (scalar) reference to an array holding the list: $memb_arr_ref = $lcm->is_member_which_ref('jerky'); In the example above, C<$memb_arr_ref> will be: [ 3, 4 ] because C<'jerky'> is found in C<@Don> and C<@Ed>, which hold positions C<3> and C<4>, respectively, in the list of arguments passed to C. B methods C and C test only one string at a time and hence take only one argument. To test more than one string at a time see the next method, C. =item * C Determine in C (if any) of the lists passed to the constructor one or more given strings can be found. The strings to be tested are placed in an anonymous array, a reference to which is passed to the method. $memb_hash_ref = $lcm->are_members_which([ qw| abel baker fargo hilton zebra | ]); I In versions of List::Compare prior to 0.25 (April 2004), the strings to be tested could be passed as a flat list. This is no longer possible; the argument must now be a reference to an anonymous array. The return value is a reference to a hash of arrays. The key for each element in this hash is the string being tested. Each element's value is a reference to an anonymous array whose elements are those indices in the constructor's argument list corresponding to lists holding the strings being tested. In the two examples above, C<$memb_hash_ref> will be: { abel => [ 0 ], baker => [ 0, 1 ], fargo => [ 0, 1, 2, 3, 4 ], hilton => [ 1, 2 ], zebra => [ ], }; B C can take more than one argument; C and C each take only one argument. C returns a hash reference; the other methods return either a list or a reference to an array holding that list, depending on context. =item * C Determine whether a given string can be found in I of the lists passed as arguments to the constructor. $found = $lcm->is_member_any('abel'); Return C<1> if a specified string can be found in I of the lists and C<0> if not. In the example above, C<$found> will be C<1> because C<'abel'> is found in one or more of the lists passed as arguments to C. =item * C Determine whether a specified string or strings can be found in I of the lists passed as arguments to the constructor. The strings to be tested are placed in an array (anonymous or named), a reference to which is passed to the method. $memb_hash_ref = $lcm->are_members_any([ qw| abel baker fargo hilton zebra | ]); I In versions of List::Compare prior to 0.25 (April 2004), the strings to be tested could be passed as a flat list. This is no longer possible; the argument must now be a reference to an anonymous array. The return value is a reference to a hash where an element's key is the string being tested and the element's value is 1 if the string can be found in C of the lists and 0 if not. In the two examples above, C<$memb_hash_ref> will be: { abel => 1, baker => 1, fargo => 1, hilton => 1, zebra => 0, }; C's value will be C<0> because C is not found in any of the lists passed as arguments to C. =item * C Return current List::Compare version number: $vers = $lcm->get_version; =back =item * Multiple Mode Methods Not Analogous to Regular and Accelerated Mode Methods =over 4 =item * C Get those items found in I of the lists passed to the constructor which do I appear in I of the lists (I all items except those found in the intersection of the lists): @nonintersection = $lcm->get_nonintersection; =item * C Get those items which appear in more than one of the lists passed to the constructor (I all items except those found in their symmetric difference); @shared = $lcm->get_shared; =item * C If you only need a reference to an array as a return value rather than a full array, use the following alternative methods: $nonintersection_ref = $lcm->get_nonintersection_ref; $shared_ref = $lcm->get_shared_ref; =item * C Get a reference to an array of array references where each of the interior arrays holds the list of those items I to the list passed to the constructor with the same index position. $unique_all_ref = $lcm->get_unique_all(); In the example above, C<$unique_all_ref> will hold: [ [ qw| abel | ], [ ], [ qw| jerky | ], [ ], [ ], ] =item * C Get a reference to an array of array references where each of the interior arrays holds the list of those items in the I to the list passed to the constructor with the same index position. $complement_all_ref = $lcm->get_complement_all(); In the example above, C<$complement_all_ref> will hold: [ [ qw| hilton icon jerky | ], [ qw| abel icon jerky | ], [ qw| abel baker camera delta edward | ], [ qw| abel baker camera delta edward jerky | ], [ qw| abel baker camera delta edward jerky | ], ] =back =back =head2 Multiple Accelerated Case: Compare Three or More Lists but Request Only a Single Comparison among the Lists =over 4 =item * Constructor C If you are certain that you will only want the results of a single comparison among three or more lists, computation may be accelerated by passing C<'-a'> or C<'--accelerated> as the first argument to the constructor. @Al = qw(abel abel baker camera delta edward fargo golfer); @Bob = qw(baker camera delta delta edward fargo golfer hilton); @Carmen = qw(fargo golfer hilton icon icon jerky kappa); @Don = qw(fargo icon jerky); @Ed = qw(fargo icon icon jerky); $lcma = List::Compare->new('-a', \@Al, \@Bob, \@Carmen, \@Don, \@Ed); As with List::Compare's other cases, should you not need to have a sorted list returned by a List::Compare method, you may achieve a speed boost by constructing the object with the unsorted option: $lcma = List::Compare->new('-u', '-a', \@Al, \@Bob, \@Carmen, \@Don, \@Ed); or $lcma = List::Compare->new('--unsorted', '--accelerated', \@Al, \@Bob, \@Carmen, \@Don, \@Ed); As was the case with List::Compare's Multiple mode, do not count the unsorted option (C<'-u'> or C<'--unsorted'>) or the accelerated option (C<'-a'> or C<'--accelerated'>) when determining the index position of a particular list in the list of array references passed to the constructor. Example: $lcmaex = List::Compare->new('--unsorted', '--accelerated', \@alpha, \@beta, \@gamma); =item * Alternative Constructor The 'single hashref' format may be used to construct a List::Compare object which calls for accelerated processing of three or more lists at once: $lcmaex = List::Compare->new( { accelerated => 1, lists => [\@alpha, \@beta, \@gamma], } ); or $lcmaex = List::Compare->new( { unsorted => 1, accelerated => 1, lists => [\@alpha, \@beta, \@gamma], } ); =item * Methods For the purpose of supplying a numerical argument to a method which optionally takes such an argument, C<'--unsorted'> and C<'--accelerated> are skipped, C<@alpha> is C<0>, C<@beta> is C<1>, and so forth. To get a list of those items unique to C<@gamma>, you would call: @gamma_only = $lcmaex->get_unique(2); =back =head2 Passing Seen-hashes to the Constructor Instead of Arrays =over 4 =item * When Seen-Hashes Are Already Available to You Suppose that in a particular Perl program, you had to do extensive munging of data from an external source and that, once you had correctly parsed a line of data, it was easier to assign that datum to a hash than to an array. More specifically, suppose that you used each datum as the key to an element of a lookup table in the form of a I: my %Llist = ( abel => 2, baker => 1, camera => 1, delta => 1, edward => 1, fargo => 1, golfer => 1, ); my %Rlist = ( baker => 1, camera => 1, delta => 2, edward => 1, fargo => 1, golfer => 1, hilton => 1, ); In other words, suppose it was more convenient to compute a lookup table I a list than to compute that list explicitly. Since in almost all cases List::Compare takes the elements in the arrays passed to its constructor and I assigns them to elements in a seen-hash, why shouldn't you be able to pass (references to) seen-hashes I to the constructor and avoid unnecessary array assignments before the constructor is called? =item * Constructor C You can now do so: $lcsh = List::Compare->new(\%Llist, \%Rlist); =item * Methods I of List::Compare's output methods are supported I when references to seen-hashes are passed to the constructor. @intersection = $lcsh->get_intersection; @union = $lcsh->get_union; @Lonly = $lcsh->get_unique; @Ronly = $lcsh->get_complement; @LorRonly = $lcsh->get_symmetric_difference; @bag = $lcsh->get_bag; $intersection_ref = $lcsh->get_intersection_ref; $union_ref = $lcsh->get_union_ref; $Lonly_ref = $lcsh->get_unique_ref; $Ronly_ref = $lcsh->get_complement_ref; $LorRonly_ref = $lcsh->get_symmetric_difference_ref; $bag_ref = $lcsh->get_bag_ref; $LR = $lcsh->is_LsubsetR; $RL = $lcsh->is_RsubsetL; $eqv = $lcsh->is_LequivalentR; $disj = $lcsh->is_LdisjointR; $lcsh->print_subset_chart; $lcsh->print_equivalence_chart; @memb_arr = $lsch->is_member_which('abel'); $memb_arr_ref = $lsch->is_member_which_ref('baker'); $memb_hash_ref = $lsch->are_members_which( [ qw| abel baker fargo hilton zebra | ]); $found = $lsch->is_member_any('abel'); $memb_hash_ref = $lsch->are_members_any( [ qw| abel baker fargo hilton zebra | ]); $vers = $lcsh->get_version; $unique_all_ref = $lcsh->get_unique_all(); $complement_all_ref = $lcsh->get_complement_all(); =item * Accelerated Mode and Seen-Hashes To accelerate processing when you want only a single comparison among two or more lists, you can pass C<'-a'> or C<'--accelerated> to the constructor before passing references to seen-hashes. $lcsha = List::Compare->new('-a', \%Llist, \%Rlist); To compare three or more lists simultaneously, pass three or more references to seen-hashes. Thus, $lcshm = List::Compare->new(\%Alpha, \%Beta, \%Gamma); will generate meaningful comparisons of three or more lists simultaneously. =item * Unsorted Results and Seen-Hashes If you do not need sorted lists returned, pass C<'-u'> or C<--unsorted> to the constructor before passing references to seen-hashes. $lcshu = List::Compare->new('-u', \%Llist, \%Rlist); $lcshau = List::Compare->new('-u', '-a', \%Llist, \%Rlist); $lcshmu = List::Compare->new('--unsorted', \%Alpha, \%Beta, \%Gamma); As was true when we were using List::Compare's Multiple and Multiple Accelerated modes, do not count any unsorted or accelerated option when determining the array index of a particular seen-hash reference passed to the constructor. =item * Alternative Constructor The 'single hashref' form of constructor is also available to build List::Compare objects where seen-hashes are used as arguments: $lcshu = List::Compare->new( { unsorted => 1, lists => [\%Llist, \%Rlist], } ); $lcshau = List::Compare->new( { unsorted => 1, accelerated => 1, lists => [\%Llist, \%Rlist], } ); $lcshmu = List::Compare->new( { unsorted => 1, lists => [\%Alpha, \%Beta, \%Gamma], } ); =back =head1 DISCUSSION: Principles =head2 General Comments List::Compare is an object-oriented implementation of very common Perl code (see "History, References and Development" below) used to determine interesting relationships between two or more lists at a time. A List::Compare object is created and automatically computes the values needed to supply List::Compare methods with appropriate results. In the current implementation List::Compare methods will return new lists containing the items found in any designated list alone (unique), any list other than a designated list (complement), the intersection and union of all lists and so forth. List::Compare also has (a) methods to return Boolean values indicating whether one list is a subset of another and whether any two lists are equivalent to each other (b) methods to pretty-print very simple charts displaying the subset and equivalence relationships among lists. Except for List::Compare's C method, B In particular, List::Compare considers two lists as equivalent if each element of the first list can be found in the second list and I. 'Equivalence' in this usage takes no note of the frequency with which elements occur in either list or their order within the lists. List::Compare asks the question: I Only when you use C to compute a bag holding the two lists do you ask the question: How many times did this item occur in this list? =head2 List::Compare Modes In its current implementation List::Compare has four modes of operation. =over 4 =item * Regular Mode List::Compare's Regular mode is based on List::Compare v0.11 -- the first version of List::Compare released to CPAN (June 2002). It compares only two lists at a time. Internally, its initializer does all computations needed to report any desired comparison and its constructor stores the results of these computations. Its public methods merely report these results. This approach has the advantage that if you need to examine more than one form of comparison between two lists (I the union, intersection and symmetric difference of two lists), the comparisons are pre-calculated. This approach is efficient because certain types of comparison presuppose that other types have already been calculated. For example, to calculate the symmetric difference of two lists, one must first determine the items unique to each of the two lists. =item * Accelerated Mode The current implementation of List::Compare offers you the option of getting even faster results I that you only need the result from a I form of comparison between two lists. (I only the union -- nothing else). In the Accelerated mode, List::Compare's initializer does no computation and its constructor stores only references to the two source lists. All computation needed to report results is deferred to the method calls. The user selects this approach by passing the option flag C<'-a'> to the constructor before passing references to the two source lists. List::Compare notes the option flag and silently switches into Accelerated mode. From the perspective of the user, there is no further difference in the code or in the results. Benchmarking suggests that List::Compare's Accelerated mode (a) is faster than its Regular mode when only one comparison is requested; (b) is about as fast as Regular mode when two comparisons are requested; and (c) becomes considerably slower than Regular mode as each additional comparison above two is requested. =item * Multiple Mode List::Compare now offers the possibility of comparing three or more lists at a time. Simply store the extra lists in arrays and pass references to those arrays to the constructor. List::Compare detects that more than two lists have been passed to the constructor and silently switches into Multiple mode. As described in the Synopsis above, comparing more than two lists at a time offers you a wider, more complex palette of comparison methods. Individual items may appear in just one source list, in all the source lists, or in some number of lists between one and all. The meaning of 'union', 'intersection' and 'symmetric difference' is conceptually unchanged when you move to multiple lists because these are properties of all the lists considered together. In contrast, the meaning of 'unique', 'complement', 'subset' and 'equivalent' changes because these are properties of one list compared with another or with all the other lists combined. List::Compare takes this complexity into account by allowing you to pass arguments to the public methods requesting results with respect to a specific list (for C and C) or a specific pair of lists (for C and C). List::Compare further takes this complexity into account by offering the new methods C and C described in the Synopsis above. =item * Multiple Accelerated Mode Beginning with version 0.25, introduced in April 2004, List::Compare offers the possibility of accelerated computation of a single comparison among three or more lists at a time. Simply store the extra lists in arrays and pass references to those arrays to the constructor preceded by the C<'-a'> argument as was done with the simple (two lists only) accelerated mode. List::Compare detects that more than two lists have been passed to the constructor and silently switches into Multiple Accelerated mode. =item * Unsorted Option When List::Compare is used to return lists representing various comparisons of two or more lists (I, the lists' union or intersection), the lists returned are, by default, sorted using Perl's default C mode: ASCII-betical sorting. Sorting produces results which are more easily human-readable but may entail a performance cost. Should you not need sorted results, you can avoid the potential performance cost by calling List::Compare's constructor using the unsorted option. This is done by calling C<'-u'> or C<'--unsorted'> as the first argument passed to the constructor, I, as an argument called before any references to lists are passed to the constructor. Note that if are calling List::Compare in the Accelerated or Multiple Accelerated mode I wish to have the lists returned in unsorted order, you I pass the argument for the unsorted option (C<'-u'> or C<'--unsorted'>) and I pass the argument for the Accelerated mode (C<'-a'> or C<'--accelerated'>). =back =head2 Miscellaneous Methods It would not really be appropriate to call C and C in Regular or Accelerated mode since they are conceptually based on the notion of comparing more than two lists at a time. However, there is always the possibility that a user may be comparing only two lists (accelerated or not) and may accidentally call one of those two methods. To prevent fatal run-time errors and to caution you to use a more appropriate method, these two methods are defined for Regular and Accelerated modes so as to return suitable results but also generate a carp message that advise you to re-code. Similarly, the method C is appropriate for the Regular and Accelerated modes but is not really appropriate for Multiple mode. As a defensive maneuver, it has been defined for Multiple mode so as to return suitable results but also to generate a carp message that advises you to re-code. In List::Compare v0.11 and earlier, the author provided aliases for various methods based on the supposition that the source lists would be referred to as 'A' and 'B'. Now that you can compare more than two lists at a time, the author feels that it would be more appropriate to refer to the elements of two-argument lists as the left-hand and right-hand elements. Hence, we are discouraging the use of methods such as C, C and C as aliases for C, C and C. However, to guarantee backwards compatibility for the vast audience of Perl programmers using earlier versions of List::Compare (all 10e1 of you) these and similar methods for subset relationships are still defined. =head2 List::Compare::SeenHash Discontinued Beginning with Version 0.26 Prior to v0.26, introduced April 11, 2004, if a user wished to pass references to seen-hashes to List::Compare's constructor rather than references to arrays, he or she had to call a different, parallel module: List::Compare::SeenHash. The code for that looked like this: use List::Compare::SeenHash; my %Llist = ( abel => 2, baker => 1, camera => 1, delta => 1, edward => 1, fargo => 1, golfer => 1, ); my %Rlist = ( baker => 1, camera => 1, delta => 2, edward => 1, fargo => 1, golfer => 1, hilton => 1, ); my $lcsh = List::Compare::SeenHash->new(\%Llist, \%Rlist); B All its functionality (and more) has been implemented in List::Compare itself, since a user can now pass I a series of array references I a series of seen-hash references to List::Compare's constructor. To simplify future maintenance of List::Compare, List::Compare::SeenHash.pm will no longer be distributed with List::Compare, nor will the files in the test suite which tested List::Compare::SeenHash upon installation be distributed. Should you still need List::Compare::SeenHash, use version 0.25 from CPAN, or simply edit your Perl programs which used List::Compare::SeenHash. Those scripts may be edited quickly with, for example, this editing command in Unix text editor F: :1,$s/List::Compare::SeenHash/List::Compare/gc =head2 A Non-Object-Oriented Interface: List::Compare::Functional Version 0.21 of List::Compare introduced List::Compare::Functional, a functional (I, non-object-oriented) interface to list comparison functions. List::Compare::Functional supports the same functions currently supported by List::Compare. It works similar to List::Compare's Accelerated and Multiple Accelerated modes (described above), bit it does not require use of the C<'-a'> flag in the function call. List::Compare::Functional will return unsorted comparisons of two lists by passing C<'-u'> or C<'--unsorted'> as the first argument to the function. Please see the documentation for List::Compare::Functional to learn how to import its functions into your main package. =head1 ASSUMPTIONS AND QUALIFICATIONS The program was created with Perl 5.6. The use of I to prepare the module's template installed C at the top of the module. This has been commented out in the actual module as the code appears to be compatible with earlier versions of Perl; how earlier the author cannot say. In particular, the author would like the module to be installable on older versions of MacPerl. As is, the author has successfully installed the module on Linux, Windows 9x and Windows 2000. See L for a list of other systems on which this version of List::Compare has been tested and installed. =head1 HISTORY, REFERENCES AND DEVELOPMENT =head2 The Code Itself List::Compare is based on code presented by Tom Christiansen & Nathan Torkington in I L (a.k.a. the 'Ram' book), O'Reilly & Associates, 1998, Recipes 4.7 and 4.8. Similar code is presented in the Camel book: I, by Larry Wall, Tom Christiansen, Jon Orwant. L, 3rd ed, O'Reilly & Associates, 2000. The list comparison code is so basic and Perlish that I suspect it may have been written by Larry himself at the dawn of Perl time. The C method was inspired by Jarkko Hietaniemi's Set::Bag module and Daniel Berger's Set::Array module, both available on CPAN. List::Compare's original objective was simply to put this code in a modular, object-oriented framework. That framework, not surprisingly, is taken mostly from Damian Conway's I L, Manning Publications, 2000. With the addition of the Accelerated, Multiple and Multiple Accelerated modes, List::Compare expands considerably in both size and capabilities. Nonetheless, Tom and Nat's I code still lies at its core: the use of hashes as look-up tables to record elements seen in lists. Please note: List::Compare is not concerned with any concept of 'equality' among lists which hinges upon the frequency with which, or the order in which, elements appear in the lists to be compared. If this does not meet your needs, you should look elsewhere or write your own module. =head2 The Inspiration I realized the usefulness of putting the list comparison code into a module while preparing an introductory level Perl course given at the New School University's Computer Instruction Center in April-May 2002. I was comparing lists left and right. When I found myself writing very similar functions in different scripts, I knew a module was lurking somewhere. I learned the truth of the mantra ''Repeated Code is a Mistake'' from a 2001 talk by Mark-Jason Dominus L to the New York Perlmongers L. See L. The first public presentation of this module took place at Perl Seminar New York L on May 21, 2002. Comments and suggestions were provided there and since by Glenn Maciag, Gary Benson, Josh Rabinowitz, Terrence Brannon and Dave Cross. The placement in the installation tree of Test::ListCompareSpecial came as a result of a question answered by Michael Graham in his talk ''Test::More to Test::Extreme'' given at Yet Another Perl Conference::Canada in Ottawa, Ontario, on May 16, 2003. In May-June 2003, Glenn Maciag made valuable suggestions which led to changes in method names and documentation in v0.20. Another presentation at Perl Seminar New York in October 2003 prompted me to begin planning List::Compare::Functional. In a November 2003 Perl Seminar New York presentation, Ben Holtzman discussed the performance costs entailed in Perl's C function. This led me to ask, ''Why should a user of List::Compare pay this performance cost if he or she doesn't need a human-readable list as a result (as would be the case if the list returned were used as the input into some other function)?'' This led to the development of List::Compare's unsorted option. An April 2004 offer by Kevin Carlson to write an article for I (L) led me to re-think whether a separate module (the former List::Compare::SeenHash) was truly needed when a user wanted to provide the constructor with references to seen-hashes rather than references to arrays. Since I had already adapted List::Compare::Functional to accept both kinds of arguments, I adapted List::Compare in the same manner. This meant that List::Compare::SeenHash and its related installation tests could be deprecated and deleted from the CPAN distribution. A remark by David H. Adler at a New York Perlmongers meeting in April 2004 led me to develop the 'single hashref' alternative constructor format, introduced in version 0.29 the following month. Presentations at two different editions of Yet Another Perl Conference (YAPC) inspired the development of List::Compare versions 0.30 and 0.31. I was selected to give a talk on List::Compare at YAPC::NA::2004 in Buffalo. This spurred me to improve certain aspects of the documentation. Version 0.31 owes its inspiration to one talk at the Buffalo YAPC and one earlier talk at YAPC::EU::2003 in Paris. In Paris I heard Paul Johnson speak on his CPAN module Devel::Cover and on coverage analysis more generally. That material was over my head at that time, but in Buffalo I heard Andy Lester discuss Devel::Cover as part of his discussion of testing and of the Phalanx project (L). This time I got it, and when I returned from Buffalo I applied Devel::Cover to List::Compare and wrote additional tests to improve its subroutine and statement coverage. In addition, I added two new methods, C and C. In writing these two methods, I followed a model of test-driven development much more so than in earlier versions of List::Compare and my other CPAN modules. The result? List::Compare's test suite grew by over 3300 tests to nearly 23,000 tests. At the Second New York Perl Hackathon (May 02 2015), a project was created to request performance improvements in certain List::Compare functions (L). Hackathon participant Michael Rawson submitted a pull request with changes to List::Compare::Base::_Auxiliary. After these revisions were benchmarked, a patch embodying the pull request was accepted, leading to CPAN version 0.53. =head2 If You Like List::Compare, You'll Love ... While preparing this module for distribution via CPAN, I had occasion to study a number of other modules already available on CPAN. Each of these modules is more sophisticated than List::Compare -- which is not surprising since all that List::Compare originally aspired to do was to avoid typing Cookbook code repeatedly. Here is a brief description of the features of these modules. (B The following discussion is only valid as of June 2002. Some of these modules may have changed since then.) =over 4 =item * Algorithm::Diff - Compute 'intelligent' differences between two files/lists (L) Algorithm::Diff is a sophisticated module originally written by Mark-Jason Dominus, later maintained by Ned Konz, now maintained by Tye McQueen. Think of the Unix C utility and you're on the right track. Algorithm::Diff exports methods such as C, which ''computes the smallest set of additions and deletions necessary to turn the first sequence into the second, and returns a description of these changes.'' Algorithm::Diff is mainly concerned with the sequence of elements within two lists. It does not export functions for intersection, union, subset status, etc. =item * Array::Compare - Perl extension for comparing arrays (L) Array::Compare, by Dave Cross, asks whether two arrays are the same or different by doing a C on each string with a separator character and comparing the resulting strings. Like List::Compare, it is an object-oriented module. A sophisticated feature of Array::Compare is that it allows you to specify how 'whitespace' in an array (an element which is undefined, the empty string, or whitespace within an element) should be evaluated for purpose of determining equality or difference. It does not directly provide methods for intersection and union. =item * List::Util - A selection of general-utility list subroutines (L) List::Util, by Graham Barr, exports a variety of simple, useful functions for operating on one list at a time. The C function returns the lowest numerical value in a list; the C function returns the highest value; and so forth. List::Compare differs from List::Util in that it is object-oriented and that it works on two strings at a time rather than just one -- but it aims to be as simple and useful as List::Util. List::Util will be included in the standard Perl distribution as of Perl 5.8.0. Lists::Util (L), by Tassilo von Parseval, building on code by Terrence Brannon, provides methods which extend List::Util's functionality. =item * Quantum::Superpositions (L), originally by Damian Conway, now maintained by Steven Lembark is useful if, in addition to comparing lists, you need to emulate quantum supercomputing as well. Not for the eigen-challenged. =item * Set::Scalar - basic set operations (L) Set::Bag - bag (multiset) class (L) Both of these modules are by Jarkko Hietaniemi. Set::Scalar has methods to return the intersection, union, difference and symmetric difference of two sets, as well as methods to return items unique to a first set and complementary to it in a second set. It has methods for reporting considerably more variants on subset status than does List::Compare. However, benchmarking suggests that List::Compare, at least in Regular mode, is considerably faster than Set::Scalar for those comparison methods which List::Compare makes available. Set::Bag enables one to deal more flexibly with the situation in which one has more than one instance of an element in a list. =item * Set::Array - Arrays as objects with lots of handy methods (including set comparisons) and support for method chaining. (L) Set::Array, by Daniel Berger, now maintained by Ron Savage, ''aims to provide built-in methods for operations that people are always asking how to do,and which already exist in languages like Ruby.'' Among the many methods in this module are some for intersection, union, etc. To install Set::Array, you must first install the Want module, also available on CPAN. =back =head1 ADDITIONAL CONTRIBUTORS =over 4 =item * Syohei YOSHIDA Pull request accepted May 22 2015. =item * Paulo Custodio Pull request accepted June 07 2015, correcting errors in C<_subset_subengine()>. =back =head1 BUGS There are no bug reports outstanding on List::Compare as of the most recent CPAN upload date of this distribution. =head1 SUPPORT Please report any bugs by mail to C or through the web interface at L. =head1 AUTHOR James E. Keenan (jkeenan@cpan.org). When sending correspondence, please include 'List::Compare' or 'List-Compare' in your subject line. Creation date: May 20, 2002. Last modification date: June 07 2015. Development repository: L =head1 COPYRIGHT Copyright (c) 2002-15 James E. Keenan. United States. All rights reserved. This is free software and may be distributed under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE ''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 SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. 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 SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (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 SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. =cut