List-Compare-0.37/0000755000076500007650000000000011022617550013661 5ustar jimkjimk00000000000000List-Compare-0.37/Changes0000644000076500007650000001344511022617237015165 0ustar jimkjimk00000000000000#$Id: Changes 1329 2008-06-07 23:49:51Z jimk $ Revision 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. List-Compare-0.37/FAQ0000644000076500007650000000353011005750454014216 0ustar jimkjimk00000000000000#$Id: FAQ 1224 2008-04-30 01:53:48Z jimk $ 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.37/lib/0000755000076500007650000000000011022617550014427 5ustar jimkjimk00000000000000List-Compare-0.37/lib/List/0000755000076500007650000000000011022617550015342 5ustar jimkjimk00000000000000List-Compare-0.37/lib/List/Compare/0000755000076500007650000000000011022617550016730 5ustar jimkjimk00000000000000List-Compare-0.37/lib/List/Compare/Base/0000755000076500007650000000000011022617550017602 5ustar jimkjimk00000000000000List-Compare-0.37/lib/List/Compare/Base/_Auxiliary.pm0000755000076500007650000005636211022617371022266 0ustar jimkjimk00000000000000package List::Compare::Base::_Auxiliary; #$Id: _Auxiliary.pm 1329 2008-06-07 23:49:51Z jimk $ $VERSION = 0.37; use Carp; @ISA = qw(Exporter); @EXPORT_OK = qw| _validate_2_seenhashes _validate_seen_hash _validate_multiple_seenhashes _calculate_union_xintersection_only _calculate_seen_xintersection_only _calculate_seen_only _calculate_xintersection_only _calculate_union_only _calculate_union_seen_only _calculate_hash_intersection _calculate_hash_shared _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_union_xintersection_only _calculate_seen_xintersection_only _calculate_seen_only _calculate_xintersection_only _calculate_union_only _calculate_union_seen_only _calculate_hash_intersection _calculate_hash_shared ) ], 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 @hashrefs = @{$hashrefsref}; my (%badentries, $badentriesflag); for (my $i = 0; $i <= $#hashrefs; $i++) { my %seenhash = %{$hashrefs[$i]}; foreach (keys %seenhash) { unless ($seenhash{$_} =~ /^\d+$/ and $seenhash{$_} > 0) { $badentries{$i}{$_} = $seenhash{$_}; $badentriesflag++; } } } my $msg = q{}; if ($badentriesflag) { $msg .= "\nValues in a 'seen-hash' must be positive integers.\n"; $msg .= " These elements have invalid values:\n\n"; foreach (sort keys %badentries) { $msg .= " Hash $_:\n"; my %pairs = %{$badentries{$_}}; foreach my $val (sort keys %pairs) { $msg .= " Bad key-value pair: $val\t$pairs{$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_union_xintersection_only { my $aref = shift; my (%union, %xintersection); for (my $i = 0; $i <= $#{$aref}; $i++) { my %seenthis = (); foreach my $h ( _list_builder($aref, $i) ) { $seenthis{$h}++; $union{$h}++; } for (my $j = $i+1; $j <=$#{$aref}; $j++) { my %seenthat = (); my %seenintersect = (); my $ilabel = $i . '_' . $j; $seenthat{$_}++ foreach ( _list_builder($aref, $j) ); foreach my $k (keys %seenthat) { $seenintersect{$k}++ if (exists $seenthis{$k}); } $xintersection{$ilabel} = \%seenintersect; } } return (\%union, \%xintersection); } sub _calculate_seen_xintersection_only { my $aref = shift; my (%xintersection, %seen); for (my $i = 0; $i <= $#{$aref}; $i++) { my %seenthis = (); foreach my $h ( _list_builder($aref, $i) ) { $seenthis{$h}++; } $seen{$i} = \%seenthis; for (my $j = $i+1; $j <=$#{$aref}; $j++) { my (%seenthat, %seenintersect); my $ilabel = $i . '_' . $j; $seenthat{$_}++ foreach ( _list_builder($aref, $j) ); foreach (keys %seenthat) { $seenintersect{$_}++ if (exists $seenthis{$_}); } $xintersection{$ilabel} = \%seenintersect; } } return (\%seen, \%xintersection); } 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_xintersection_only { my $aref = shift; my (%xintersection); for (my $i = 0; $i <= $#{$aref}; $i++) { my %seenthis = (); foreach my $h ( _list_builder($aref, $i) ) { $seenthis{$h}++; } for (my $j = $i+1; $j <=$#{$aref}; $j++) { my (%seenthat, %seenintersect); my $ilabel = $i . '_' . $j; $seenthat{$_}++ foreach ( _list_builder($aref, $j) ); foreach (keys %seenthat) { $seenintersect{$_}++ if (exists $seenthis{$_}); } $xintersection{$ilabel} = \%seenintersect; } } return \%xintersection; } 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_hash_intersection { my $xintersectionref = shift; my @xkeys = keys %{$xintersectionref}; my %intersection = %{${$xintersectionref}{$xkeys[0]}}; for (my $m = 1; $m <= $#xkeys; $m++) { my %compare = %{${$xintersectionref}{$xkeys[$m]}}; my %result = (); foreach (keys %compare) { $result{$_}++ if (exists $intersection{$_}); } %intersection = %result; } return \%intersection; } sub _calculate_hash_shared { my $xintersectionref = shift; my (%shared); foreach my $q (keys %{$xintersectionref}) { $shared{$_}++ foreach (keys %{${$xintersectionref}{$q}}); } return \%shared; } sub _subset_subengine { my $aref = shift; my (@xsubset); my $seenref = _calculate_seen_only($aref); my %seen = %{$seenref}; foreach my $i (keys %seen) { my %tempi = %{$seen{$i}}; foreach my $j (keys %seen) { my %tempj = %{$seen{$j}}; $xsubset[$i][$j] = 1; foreach my $k (keys %tempi) { $xsubset[$i][$j] = 0 if (! $tempj{$k}); } } } 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 $xsubsetref = _subset_subengine($aref); my @xsubset = @{$xsubsetref}; 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.37 of List::Compare::Base::_Auxiliary. This version was released June 07, 2008. =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, 2008. Copyright (c) 2002-08 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.37/lib/List/Compare/Base/_Engine.pm0000755000076500007650000000560711022617237021521 0ustar jimkjimk00000000000000package List::Compare::Base::_Engine; #$Id: _Engine.pm 1329 2008-06-07 23:49:51Z jimk $ $VERSION = 0.37; # Holds subroutines used within # List::Compare::Base::Accelerated and List::Compare::Functional # As of: 09/18/2005 use Carp; use List::Compare::Base::_Auxiliary qw( _equiv_engine _calculate_seen_xintersection_only _calculate_union_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, $xintersectionref) = _calculate_seen_xintersection_only($aref); my %seen = %{$seenref}; my %xintersection = %{$xintersectionref}; # Calculate @xunique # Inputs: $aref %seen %xintersection my (@xunique); for (my $i = 0; $i <= $#{$aref}; $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{$_}; } } foreach my $ded (keys %deductions) { foreach (keys %{$deductions{$ded}}) { $alldeductions{$_}++; } } foreach (keys %seenthis) { push(@uniquethis, $_) unless ($alldeductions{$_}); } $xunique[$i] = \@uniquethis; } return \@xunique; } sub _complement_all_engine { my ($aref, $unsortflag) = @_; my ($unionref, $seenref) = _calculate_union_seen_only($aref); my %seen = %{$seenref}; my @union = $unsortflag ? keys %{$unionref} : sort(keys %{$unionref}); # Calculate @xcomplement # Inputs: $aref @union %seen my (@xcomplement); for (my $i = 0; $i <= $#{$aref}; $i++) { my %seenthis = %{$seen{$i}}; my @complementthis = (); foreach (@union) { push(@complementthis, $_) unless (exists $seenthis{$_}); } $xcomplement[$i] = \@complementthis; } return \@xcomplement; } 1; __END__ =head1 NAME List::Compare::Base::_Engine - Internal use only =head1 VERSION This document refers to version 0.37 of List::Compare::Base::_Engine. This version was released June 07, 2008. =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, 2008. Copyright (c) 2002-04 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.37/lib/List/Compare/Functional.pm0000755000076500007650000014700311022617371021401 0ustar jimkjimk00000000000000package List::Compare::Functional; #$Id: Functional.pm 1329 2008-06-07 23:49:51Z jimk $ $VERSION = 0.37; @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 $xintersectionref = _calculate_xintersection_only($seenrefsref); my $intersectionref = _calculate_hash_intersection($xintersectionref); return [ keys %{$intersectionref} ]; } 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 $tested = pop(@_); my $seenrefsref = _calc_seen1(@_); my ($seenref, $xintersectionref) = _calculate_seen_xintersection_only($seenrefsref); my %seen = %{$seenref}; my %xintersection = %{$xintersectionref}; # Calculate %xunique my (%xunique); for (my $i = 0; $i <= $#{$seenrefsref}; $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{$_}; } } foreach my $ded (keys %deductions) { foreach (keys %{$deductions{$ded}}) { $alldeductions{$_}++; } } foreach (keys %seenthis) { push(@uniquethis, $_) unless ($alldeductions{$_}); } $xunique{$i} = \@uniquethis; } return [ @{$xunique{$tested}} ]; } 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); my %seen = %{$seenref}; my @union = keys %{$unionref}; # Calculate %xcomplement # Inputs: $seenrefsref @union %seen my (%xcomplement); for (my $i = 0; $i <= $#{$seenrefsref}; $i++) { my %seenthis = %{$seen{$i}}; my @complementthis = (); foreach (@union) { push(@complementthis, $_) unless (exists $seenthis{$_}); } $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 { my $seenrefsref = _calc_seen1(@_); my ($unionref, $xintersectionref) = _calculate_union_xintersection_only($seenrefsref); my @union = keys %{$unionref}; my $sharedref = _calculate_hash_shared($xintersectionref); my (@symmetric_difference); foreach (@union) { push(@symmetric_difference, $_) unless exists ${$sharedref}{$_}; } 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(@_); # Calculate @shared # Inputs: %xintersection my $xintersectionref = _calculate_xintersection_only($seenrefsref); my $sharedref = _calculate_hash_shared($xintersectionref); my @shared = keys %{$sharedref}; return \@shared; } 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, $xintersectionref) = _calculate_union_xintersection_only($seenrefsref); my @union = keys %{$unionref}; my $intersectionref = _calculate_hash_intersection($xintersectionref); # Calculate nonintersection # Inputs: @union %intersection my (@nonintersection); foreach (@union) { push(@nonintersection, $_) unless exists ${$intersectionref}{$_}; } 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 $xintersectionref = _calculate_xintersection_only($seenrefsref); my (@xdisjoint); for (my $i = 0; $i <= @{$seenrefsref}; $i++) { foreach (keys %{$xintersectionref}) { my ($left, $right) = split /_/, $_; $xdisjoint[$left][$right] = $xdisjoint[$right][$left] = ! scalar(keys %{${$xintersectionref}{$_}}) ? 1 : 0; } $xdisjoint[$i][$i] = 0; } my $disjoint_status = $xdisjoint[${$testedref}[1]][${$testedref}[0]]; return $disjoint_status; } 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.37 of List::Compare::Functional. This version was released June 07, 2008. 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, 2008. Copyright (c) 2002-08 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.37/lib/List/Compare.pm0000755000076500007650000032252311022617371017301 0ustar jimkjimk00000000000000package List::Compare; #$Id: Compare.pm 1329 2008-06-07 23:49:51Z jimk $ $VERSION = '0.37'; 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, $self, $dataref, $unsortflag); 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; # bless a ref to an empty hash into the invoking class if (@args > 2) { if ($accelerated) { $class .= '::Multiple::Accelerated'; $self = bless {}, $class; } else { $class .= '::Multiple'; $self = bless {}, $class; } } elsif (@args == 2) { if ($accelerated) { $class .= '::Accelerated'; $self = bless {}, $class; } else { $self = bless {}, $class; } } 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 $unsortflag = $unsorted ? 1 : 0; $dataref = $self->_init($unsortflag, @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 _prepare_listrefs _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); # Calculate overall intersection # Inputs: %xintersection my $xintersectionref = _calculate_xintersection_only($aref); my $intersectionref = _calculate_hash_intersection($xintersectionref); my @intersection = $unsortflag ? keys %{$intersectionref} : sort(keys %{$intersectionref}); 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, $xintersectionref) = _calculate_union_xintersection_only($aref); my @union = $unsortflag ? keys %{$unionref} : sort(keys %{$unionref}); my $intersectionref = _calculate_hash_intersection($xintersectionref); # Calculate nonintersection # Inputs: @union %intersection my (@nonintersection); foreach (@union) { push(@nonintersection, $_) unless exists ${$intersectionref}{$_}; } return \@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); # Calculate @shared # Inputs: %xintersection my $xintersectionref = _calculate_xintersection_only($aref); my $sharedref = _calculate_hash_shared($xintersectionref); my @shared = $unsortflag ? keys %{$sharedref} : sort(keys %{$sharedref}); 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, $xintersectionref) = _calculate_union_xintersection_only($aref); my @union = $unsortflag ? keys %{$unionref} : sort(keys %{$unionref}); my $sharedref = _calculate_hash_shared($xintersectionref); my (@symmetric_difference); foreach (@union) { push(@symmetric_difference, $_) unless exists ${$sharedref}{$_}; } return \@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 (@xdisjoint); my $xintersectionref = _calculate_xintersection_only($aref); for (my $i = 0; $i <= $#{$aref}; $i++) { foreach (keys %{$xintersectionref}) { my ($left, $right) = split /_/, $_; $xdisjoint[$left][$right] = $xdisjoint[$right][$left] = ! scalar(keys %{${$xintersectionref}{$_}}) ? 1 : 0; } $xdisjoint[$i][$i] = 0; } my $disjoint_status = $xdisjoint[$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 $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 needs at least one argument: $!" unless (@_); 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]}; # @args = (@_ == 1 and ref($_[0]) eq 'ARRAY') # ? @{$_[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.37 of List::Compare. This version was released June 07, 2008. =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. =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 BUGS There are no bug reports outstanding on List::Compare as of the most recent CPAN upload date of this distribution. =head1 SUPPORT Support for List::Compare is now provided by mailing list: L. 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, 2008. =head1 COPYRIGHT Copyright (c) 2002-06 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 List-Compare-0.37/Makefile.PL0000644000076500007650000000051611005750454015637 0ustar jimkjimk00000000000000#$Id: Makefile.PL 1224 2008-04-30 01:53:48Z jimk $ use ExtUtils::MakeMaker; require 5.006; WriteMakefile( NAME => 'List::Compare', AUTHOR => 'James E Keenan (jkeenan@cpan.org)', VERSION_FROM => 'lib/List/Compare.pm', ABSTRACT_FROM => 'lib/List/Compare.pm', PREREQ_PM => { Test::Simple => 0.10 }, ); List-Compare-0.37/MANIFEST0000644000076500007650000000367611022617440015024 0ustar jimkjimk00000000000000Changes 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 MANIFEST.SKIP META.yml Module meta-data (added by MakeMaker) 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/90_oo_errors.t t/91_func_errors.t t/IO/CaptureOutput.pm t/Test/ListCompareSpecial.pm List-Compare-0.37/MANIFEST.SKIP0000644000076500007650000000041611012021101015534 0ustar jimkjimk00000000000000^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 List-Compare-0.37/META.yml0000644000076500007650000000070311022617550015132 0ustar jimkjimk00000000000000--- #YAML:1.0 name: List-Compare version: 0.37 abstract: Compare elements of two or more lists license: ~ author: - James E Keenan (jkeenan@cpan.org) generated_by: ExtUtils::MakeMaker version 6.42 distribution_type: module requires: Test::Simple: 0.1 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html version: 1.3 List-Compare-0.37/README0000644000076500007650000000633611022617237014553 0ustar jimkjimk00000000000000#$Id: README 1329 2008-06-07 23:49:51Z jimk $ List::Compare - Compare elements of two or more lists This document refers to version 0.37 of List::Compare. This version was released June 07, 2008. To install this module on your system, place the tarball archive file in a temporary directory and call the following: % gunzip List-Compare-0.37.tar.gz % tar xf List-Compare-0.37.tar % cd List-Compare-0.37 % 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-08 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.37/t/0000755000076500007650000000000011022617550014124 5ustar jimkjimk00000000000000List-Compare-0.37/t/01_oo_lists_dual_reg_sorted.t0000755000076500007650000002641311020370652021674 0ustar jimkjimk00000000000000# perl #$Id: 01_oo_lists_dual_reg_sorted.t 1309 2008-06-01 00:47:38Z jimk $ # 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.37/t/02_oo_lists_dual_reg_unsorted.t0000755000076500007650000003402711014140606022235 0ustar jimkjimk00000000000000# perl #$Id: 02_oo_lists_dual_reg_unsorted.t 1304 2008-05-18 23:53:42Z jimk $ # 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.37/t/03_oo_lists_dual_acc_sorted.t0000755000076500007650000002731511020370652021651 0ustar jimkjimk00000000000000# perl #$Id: 03_oo_lists_dual_acc_sorted.t 1309 2008-06-01 00:47:38Z jimk $ # 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.37/t/04_oo_lists_dual_acc_unsorted.t0000755000076500007650000003605311011353255022214 0ustar jimkjimk00000000000000# perl #$Id: 04_oo_lists_dual_acc_unsorted.t 1281 2008-05-10 17:09:01Z jimk $ # 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.37/t/05_oo_lists_mult_reg_sorted.t0000755000076500007650000004560211021100232021717 0ustar jimkjimk00000000000000# perl #$Id: 05_oo_lists_mult_reg_sorted.t 1317 2008-06-02 23:22:02Z jimk $ # 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.37/t/06_oo_lists_mult_reg_unsorted.t0000755000076500007650000004343311011622016022273 0ustar jimkjimk00000000000000# perl #$Id: 06_oo_lists_mult_reg_unsorted.t 1288 2008-05-11 16:51:26Z jimk $ # 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.37/t/07_oo_lists_mult_acc_sorted.t0000755000076500007650000004556311021100232021700 0ustar jimkjimk00000000000000# perl #$Id: 07_oo_lists_mult_acc_sorted.t 1317 2008-06-02 23:22:02Z jimk $ # 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.37/t/08_oo_lists_mult_acc_unsorted.t0000755000076500007650000004371011011622016022244 0ustar jimkjimk00000000000000# perl #$Id: 08_oo_lists_mult_acc_unsorted.t 1288 2008-05-11 16:51:26Z jimk $ # 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.37/t/09_oo_lists_alt_dual_reg_sorted.t0000755000076500007650000002504611014140606022542 0ustar jimkjimk00000000000000# perl #$Id: 09_oo_lists_alt_dual_reg_sorted.t 1304 2008-05-18 23:53:42Z jimk $ # 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.37/t/10_oo_lists_alt_dual_reg_unsorted.t0000755000076500007650000003452011014140606023072 0ustar jimkjimk00000000000000# perl #$Id: 10_oo_lists_alt_dual_reg_unsorted.t 1304 2008-05-18 23:53:42Z jimk $ # 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.37/t/11_oo_lists_alt_dual_acc_sorted.t0000755000076500007650000002555411020370526022513 0ustar jimkjimk00000000000000# perl #$Id: 11_oo_lists_alt_dual_acc_sorted.t 1308 2008-06-01 00:46:14Z jimk $ # 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.37/t/12_oo_lists_alt_dual_acc_unsorted.t0000755000076500007650000003375411011347526023064 0ustar jimkjimk00000000000000# perl #$Id: 12_oo_lists_alt_dual_acc_unsorted.t 1279 2008-05-10 16:37:42Z jimk $ # 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.37/t/13_oo_lists_alt_mult_reg_sorted.t0000755000076500007650000004233211011622016022563 0ustar jimkjimk00000000000000# perl #$Id: 13_oo_lists_alt_mult_reg_sorted.t 1288 2008-05-11 16:51:26Z jimk $ # 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.37/t/14_oo_lists_alt_mult_reg_unsorted.t0000755000076500007650000004334711011622016023136 0ustar jimkjimk00000000000000# perl #$Id: 14_oo_lists_alt_mult_reg_unsorted.t 1288 2008-05-11 16:51:26Z jimk $ # 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.37/t/15_oo_lists_alt_mult_acc_sorted.t0000755000076500007650000004270211011622016022537 0ustar jimkjimk00000000000000# perl #$Id: 15_oo_lists_alt_mult_acc_sorted.t 1288 2008-05-11 16:51:26Z jimk $ # 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.37/t/16_oo_lists_alt_mult_acc_unsorted.t0000755000076500007650000004370011011622016023102 0ustar jimkjimk00000000000000# perl #$Id: 16_oo_lists_alt_mult_acc_unsorted.t 1288 2008-05-11 16:51:26Z jimk $ # 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.37/t/17_oo_hashes_dual_reg_sorted.t0000755000076500007650000002335711014140606022021 0ustar jimkjimk00000000000000# perl #$Id: 17_oo_hashes_dual_reg_sorted.t 1304 2008-05-18 23:53:42Z jimk $ # 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.37/t/18_oo_hashes_dual_reg_unsorted.t0000755000076500007650000003403511014140607022361 0ustar jimkjimk00000000000000# perl #$Id: 18_oo_hashes_dual_reg_unsorted.t 1304 2008-05-18 23:53:42Z jimk $ # 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.37/t/19_oo_hashes_dual_acc_sorted.t0000755000076500007650000002457111011354060021771 0ustar jimkjimk00000000000000# perl #$Id: 19_oo_hashes_dual_acc_sorted.t 1282 2008-05-10 17:15:28Z jimk $ # 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.37/t/20_oo_hashes_dual_acc_unsorted.t0000755000076500007650000003620611011354060022322 0ustar jimkjimk00000000000000# perl #$Id: 20_oo_hashes_dual_acc_unsorted.t 1282 2008-05-10 17:15:28Z jimk $ # 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.37/t/21_oo_hashes_mult_reg_sorted.t0000755000076500007650000004125411021222122022034 0ustar jimkjimk00000000000000# perl #$Id: 21_oo_hashes_mult_reg_sorted.t 1288 2008-05-11 16:51:26Z jimk $ # 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.37/t/22_oo_hashes_mult_reg_unsorted.t0000755000076500007650000004343411011622016022407 0ustar jimkjimk00000000000000# perl #$Id: 22_oo_hashes_mult_reg_unsorted.t 1288 2008-05-11 16:51:26Z jimk $ # 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.37/t/23_oo_hashes_mult_acc_sorted.t0000755000076500007650000004145111011622016022013 0ustar jimkjimk00000000000000# perl #$Id: 23_oo_hashes_mult_acc_sorted.t 1288 2008-05-11 16:51:26Z jimk $ # 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.37/t/24_oo_hashes_mult_acc_unsorted.t0000755000076500007650000004371211011622016022361 0ustar jimkjimk00000000000000# perl #$Id: 24_oo_hashes_mult_acc_unsorted.t 1288 2008-05-11 16:51:26Z jimk $ # 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.37/t/25_oo_hashes_alt_dual_reg_sorted.t0000755000076500007650000002472511020370652022663 0ustar jimkjimk00000000000000# perl #$Id: 25_oo_hashes_alt_dual_reg_sorted.t 1309 2008-06-01 00:47:38Z jimk $ # 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.37/t/26_oo_hashes_alt_dual_reg_unsorted.t0000755000076500007650000003607711014140607023230 0ustar jimkjimk00000000000000# perl #$Id: 26_oo_hashes_alt_dual_reg_unsorted.t 1304 2008-05-18 23:53:42Z jimk $ # 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.37/t/27_oo_hashes_alt_dual_acc_sorted.t0000755000076500007650000002460711011456737022646 0ustar jimkjimk00000000000000# perl #$Id: 27_oo_hashes_alt_dual_acc_sorted.t 1284 2008-05-11 02:45:50Z jimk $ # 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.37/t/28_oo_hashes_alt_dual_acc_unsorted.t0000755000076500007650000003525011011456737023206 0ustar jimkjimk00000000000000# perl #$Id: 28_oo_hashes_alt_dual_acc_unsorted.t 1284 2008-05-11 02:45:50Z jimk $ # 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.37/t/29_oo_hashes_alt_mult_reg_sorted.t0000755000076500007650000004135611011622016022714 0ustar jimkjimk00000000000000# perl #$Id: 29_oo_hashes_alt_mult_reg_sorted.t 1288 2008-05-11 16:51:26Z jimk $ # 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.37/t/30_oo_hashes_alt_mult_reg_unsorted.t0000755000076500007650000004335111011622016023244 0ustar jimkjimk00000000000000# perl #$Id: 30_oo_hashes_alt_mult_reg_unsorted.t 1288 2008-05-11 16:51:26Z jimk $ # 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.37/t/31_oo_hashes_alt_mult_acc_sorted.t0000755000076500007650000004165211011622016022655 0ustar jimkjimk00000000000000# perl #$Id: 31_oo_hashes_alt_mult_acc_sorted.t 1288 2008-05-11 16:51:26Z jimk $ # 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.37/t/32_oo_hashes_alt_mult_acc_unsorted.t0000755000076500007650000004370011011622016023215 0ustar jimkjimk00000000000000# perl #$Id: 32_oo_hashes_alt_mult_acc_unsorted.t 1288 2008-05-11 16:51:26Z jimk $ # 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.37/t/33_func_lists_dual_sorted.t0000755000076500007650000001645011021110650021351 0ustar jimkjimk00000000000000# perl #$Id: 33_func_lists_dual_sorted.t 1318 2008-06-03 00:34:48Z jimk $ # 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.37/t/34_func_lists_dual_unsorted.t0000755000076500007650000001730011021127723021721 0ustar jimkjimk00000000000000# perl #$Id: 34_func_lists_dual_unsorted.t 1322 2008-06-03 02:43:30Z jimk $ # 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.37/t/35_func_lists_mult_sorted.t0000755000076500007650000002224711021100232021403 0ustar jimkjimk00000000000000# perl #$Id: 35_func_lists_mult_sorted.t 1317 2008-06-02 23:22:02Z jimk $ # 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.37/t/36_func_lists_mult_unsorted.t0000755000076500007650000002042311013144402021751 0ustar jimkjimk00000000000000# perl #$Id: 36_func_lists_mult_unsorted.t 1300 2008-05-15 23:36:34Z jimk $ # 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.37/t/37_func_lists_alt_dual_sorted.t0000755000076500007650000001751711021112563022227 0ustar jimkjimk00000000000000# perl #$Id: 37_func_lists_alt_dual_sorted.t 1320 2008-06-03 00:50:59Z jimk $ # 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.37/t/38_func_lists_alt_dual_unsorted.t0000755000076500007650000001661111013143200022556 0ustar jimkjimk00000000000000# perl #$Id: 38_func_lists_alt_dual_unsorted.t 1299 2008-05-15 23:25:52Z jimk $ # 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.37/t/39_func_lists_alt_mult_sorted.t0000755000076500007650000002010111013143200022235 0ustar jimkjimk00000000000000# perl #$Id: 39_func_lists_alt_mult_sorted.t 1299 2008-05-15 23:25:52Z jimk $ # 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.37/t/40_func_lists_alt_mult_unsorted.t0000755000076500007650000002174511013143200022607 0ustar jimkjimk00000000000000# perl #$Id: 40_func_lists_alt_mult_unsorted.t 1299 2008-05-15 23:25:52Z jimk $ # 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.37/t/41_func_hashes_dual_sorted.t0000755000076500007650000001474111013144402021471 0ustar jimkjimk00000000000000# perl #$Id: 41_func_hashes_dual_sorted.t 1300 2008-05-15 23:36:34Z jimk $ # 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.37/t/42_func_hashes_dual_unsorted.t0000755000076500007650000001573711013144402022043 0ustar jimkjimk00000000000000# perl #$Id: 42_func_hashes_dual_unsorted.t 1300 2008-05-15 23:36:34Z jimk $ # 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.37/t/43_func_hashes_mult_sorted.t0000755000076500007650000001674311013144402021533 0ustar jimkjimk00000000000000# perl #$Id: 43_func_hashes_mult_sorted.t 1300 2008-05-15 23:36:34Z jimk $ # 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.37/t/44_func_hashes_mult_unsorted.t0000755000076500007650000002042411013144402022066 0ustar jimkjimk00000000000000# perl #$Id: 44_func_hashes_mult_unsorted.t 1300 2008-05-15 23:36:34Z jimk $ # 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.37/t/45_func_hashes_alt_dual_sorted.t0000755000076500007650000001604011013145154022334 0ustar jimkjimk00000000000000# perl #$Id: 45_func_hashes_alt_dual_sorted.t 1301 2008-05-15 23:42:36Z jimk $ # 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.37/t/46_func_hashes_alt_dual_unsorted.t0000755000076500007650000001661311013145154022706 0ustar jimkjimk00000000000000# perl #$Id: 46_func_hashes_alt_dual_unsorted.t 1301 2008-05-15 23:42:36Z jimk $ # 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.37/t/47_func_hashes_alt_mult_sorted.t0000755000076500007650000002010311013145154022365 0ustar jimkjimk00000000000000# perl #$Id: 47_func_hashes_alt_mult_sorted.t 1301 2008-05-15 23:42:36Z jimk $ # 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.37/t/48_func_hashes_alt_mult_unsorted.t0000755000076500007650000002174711013145154022750 0ustar jimkjimk00000000000000# perl #$Id: 48_func_hashes_alt_mult_unsorted.t 1301 2008-05-15 23:42:36Z jimk $ # 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.37/t/90_oo_errors.t0000755000076500007650000001411011021407460016626 0ustar jimkjimk00000000000000# perl #$Id: 90_oo_errors.t 1326 2008-06-04 03:42:40Z jimk $ # 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.37/t/91_func_errors.t0000755000076500007650000001726711020370526017166 0ustar jimkjimk00000000000000# perl #$Id: 91_func_errors.t 1308 2008-06-01 00:46:14Z jimk $ # 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.37/t/IO/0000755000076500007650000000000011022617550014433 5ustar jimkjimk00000000000000List-Compare-0.37/t/IO/CaptureOutput.pm0000444000076500007650000001662411015671065017627 0ustar jimkjimk00000000000000# $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.37/t/Test/0000755000076500007650000000000011022617550015043 5ustar jimkjimk00000000000000List-Compare-0.37/t/Test/ListCompareSpecial.pm0000755000076500007650000003015711012716222021130 0ustar jimkjimk00000000000000package 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; }