# 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");