From 1cf8b248836a0ec35e6c389286fe4b46118cb379 Mon Sep 17 00:00:00 2001 From: dakkar Date: Fri, 17 Jun 2016 17:05:56 +0100 Subject: 'bag' is in Test2::Suite 0.000032! --- t/lib/Test/Sietima.pm | 2 - t/lib/Test2/Compare/Bag.pm | 109 ----------------------------- t/lib/Test2/Tools/MoreCompare.pm | 55 --------------- t/tests/sietima/message.t | 1 - t/tests/test2/compare-bag.t | 147 --------------------------------------- t/tests/test2/morecompare.t | 75 -------------------- 6 files changed, 389 deletions(-) delete mode 100644 t/lib/Test2/Compare/Bag.pm delete mode 100644 t/lib/Test2/Tools/MoreCompare.pm delete mode 100644 t/tests/test2/compare-bag.t delete mode 100644 t/tests/test2/morecompare.t (limited to 't') diff --git a/t/lib/Test/Sietima.pm b/t/lib/Test/Sietima.pm index e61640a..0b80e42 100644 --- a/t/lib/Test/Sietima.pm +++ b/t/lib/Test/Sietima.pm @@ -9,7 +9,6 @@ use Email::Sender::Transport::Test; use Data::Printer; use Sietima; use Test2::Bundle::Extended; -use Test2::Tools::MoreCompare qw(bag); use Test2::API qw(context); use namespace::clean; @@ -17,7 +16,6 @@ sub import { my $target = caller; Test2::Bundle::Extended->import::into($target); Test2::Plugin::DieOnFail->import::into($target); - Test2::Tools::MoreCompare->import::into($target,qw(bag)); for my $function (qw(transport make_sietima make_mail deliveries_are test_sending)) { no strict 'refs'; diff --git a/t/lib/Test2/Compare/Bag.pm b/t/lib/Test2/Compare/Bag.pm deleted file mode 100644 index e4dc224..0000000 --- a/t/lib/Test2/Compare/Bag.pm +++ /dev/null @@ -1,109 +0,0 @@ -package Test2::Compare::Bag; -use strict; -use warnings; - -use base 'Test2::Compare::Base'; - -our $VERSION = '0.000030'; - -use Test2::Util::HashBase qw/ending items/; - -use Carp qw/croak confess/; -use Scalar::Util qw/reftype looks_like_number/; - -sub init { - my $self = shift; - - $self->{+ITEMS} ||= []; - - $self->SUPER::init(); -} - -sub name { '' } - -sub verify { - my $self = shift; - my %params = @_; - - return 0 unless $params{exists}; - my $got = $params{got} || return 0; - return 0 unless ref($got); - return 0 unless reftype($got) eq 'ARRAY'; - return 1; -} - -sub add_item { - my $self = shift; - my $check = pop; - my ($idx) = @_; - - push @{$self->{+ITEMS}}, $check; -} - -sub deltas { - my $self = shift; - my %params = @_; - my ($got, $convert, $seen) = @params{qw/got convert seen/}; - - my @deltas; - my $state = 0; - my @items = @{$self->{+ITEMS}}; - - # Make a copy that we can munge as needed. - my @list = @$got; - my %unmatched = map { $_ => $list[$_] } 0..$#list; - - while (@items) { - my $item = shift @items; - - my $check = $convert->($item); - - my @item_deltas; - for my $idx (0..$#list) { - my $val = $list[$idx]; - my @this_deltas = $check->run( - id => [ARRAY => $idx], - convert => $convert, - seen => $seen, - exists => 1, - got => $val, - ); - if (@this_deltas) { - push @item_deltas,@this_deltas; - } - else { - @item_deltas = (); - delete $unmatched{$idx}; - last; - } - } - if (@item_deltas) { - push @deltas, $self->delta_class->new( - dne => 'got', - verified => 1, - id => [ARRAY => '*'], - got => undef, - check => $check, - children => \@item_deltas, - ); - } - } - - # if elements are left over, and ending is true, we have a problem! - if($self->{+ENDING} && keys %unmatched) { - for my $idx (sort keys %unmatched) { - my $elem = $list[$idx]; - push @deltas => $self->delta_class->new( - dne => 'check', - verified => undef, - id => [ARRAY => $idx], - got => $elem, - check => undef, - ); - } - } - - return @deltas; -} - -1; diff --git a/t/lib/Test2/Tools/MoreCompare.pm b/t/lib/Test2/Tools/MoreCompare.pm deleted file mode 100644 index 7ff16ab..0000000 --- a/t/lib/Test2/Tools/MoreCompare.pm +++ /dev/null @@ -1,55 +0,0 @@ -package Test2::Tools::MoreCompare; -use strict; -use warnings; - -use Carp qw/croak/; -use Scalar::Util qw/reftype/; - -use Test2::API qw/context/; -use Test2::Util::Ref qw/rtype/; - -use Test2::Compare qw{ - compare - get_build push_build pop_build build - strict_convert relaxed_convert -}; - -use Test2::Compare::Bag(); - -%Carp::Internal = ( - %Carp::Internal, - 'Test2::Tools::MoreCompare' => 1, - 'Test2::Compare::Bag' => 1, -); - -our @EXPORT_OK = qw{ - bag call_list -}; -use base 'Exporter'; - -sub bag(&) { build('Test2::Compare::Bag', @_) } - -sub call_list($$) { - my ($name, $expect) = @_; - my $build = get_build() or croak "No current build!"; - - croak "'$build' does not support method calls" - unless $build->can('add_call'); - - croak "'call_list' should only ever be called in void context" - if defined wantarray; - - my @caller = caller; - $build->add_call( - sub { [ shift->$name ] }, - Test2::Compare::Wildcard->new( - expect => $expect, - file => $caller[1], - lines => [$caller[2]], - ), - $name, - ); - -} - -1; diff --git a/t/tests/sietima/message.t b/t/tests/sietima/message.t index e4bed41..2db7fda 100644 --- a/t/tests/sietima/message.t +++ b/t/tests/sietima/message.t @@ -4,7 +4,6 @@ use warnings; use 5.020; use lib 't/lib'; use Test2::Bundle::Extended; -use Test2::Tools::MoreCompare qw(bag); use Test2::Plugin::DieOnFail; use Email::Stuffer; use Sietima::Message; diff --git a/t/tests/test2/compare-bag.t b/t/tests/test2/compare-bag.t deleted file mode 100644 index 80a7bc3..0000000 --- a/t/tests/test2/compare-bag.t +++ /dev/null @@ -1,147 +0,0 @@ -#!perl -use strict; -use warnings; -use 5.020; -use lib 't/lib'; -use Test2::Bundle::Extended -target => 'Test2::Compare::Bag'; - -isa_ok($CLASS, 'Test2::Compare::Base'); -is($CLASS->name, '', "got name"); - -subtest construction => sub { - my $one = $CLASS->new(); - isa_ok($one, $CLASS); - is($one->items, [], "created items as an array"); -}; - -subtest verify => sub { - my $one = $CLASS->new; - - is($one->verify(exists => 0), 0, "did not get anything"); - is($one->verify(exists => 1, got => undef), 0, "undef is not an array"); - is($one->verify(exists => 1, got => 0), 0, "0 is not an array"); - is($one->verify(exists => 1, got => 1), 0, "1 is not an array"); - is($one->verify(exists => 1, got => 'string'), 0, "'string' is not an array"); - is($one->verify(exists => 1, got => {}), 0, "a hash is not an array"); - is($one->verify(exists => 1, got => []), 1, "an array is an array"); -}; - -subtest add_item => sub { - my $one = $CLASS->new(); - - $one->add_item('a'); - $one->add_item(1 => 'b'); - $one->add_item(3 => 'd'); - - ok( - lives { $one->add_item(2 => 'c') }, - "Indexes are ignored", - ); - - $one->add_item(8 => 'x'); - $one->add_item('y'); - - is( - $one->items, - [ 'a', 'b', 'd', 'c', 'x', 'y' ], - "Expected items", - ); -}; - -subtest deltas => sub { - my $conv = Test2::Compare->can('strict_convert'); - - my %params = (exists => 1, convert => $conv, seen => {}); - - my $items = ['a', 'b']; - my $one = $CLASS->new(items => $items); - - like( - [$one->deltas(%params, got => ['a', 'b'])], - [], - "No delta, no diff" - ); - - like( - [$one->deltas(%params, got => ['b', 'a'])], - [], - "No delta, no diff, order is ignored" - ); - - like( - [$one->deltas(%params, got => ['a'])], - [ - { - dne => 'got', - id => [ARRAY => '*'], - got => undef,, - chk => {input => 'b'}, - children => [ - { - dne => DNE, - id => [ARRAY => 0], - got => 'a', - chk => {input => 'b'}, - }, - ], - } - ], - "Got the delta for the missing value" - ); - - like( - [$one->deltas(%params, got => ['a', 'a'])], - [ - { - dne => 'got', - id => [ARRAY => '*'], - got => undef, - chk => {input => 'b'}, - children => [ - { - dne => DNE, - id => [ARRAY => 0], - got => 'a', - chk => {input => 'b'}, - }, - { - dne => DNE, - id => [ARRAY => 1], - got => 'a', - chk => {input => 'b'}, - }, - ], - } - ], - "Got the delta for the incorrect value" - ); - - like( - [$one->deltas(%params, got => ['a', 'b', 'a', 'a'])], - [], - "No delta, not checking ending" - ); - - $one->set_ending(1); - like( - [$one->deltas(%params, got => ['a', 'b', 'a', 'x'])], - array { - item 0 => { - dne => 'check', - id => [ARRAY => 2], - got => 'a', - check => DNE, - }; - item 1 => { - dne => 'check', - id => [ARRAY => 3], - got => 'x', - check => DNE, - }; - end(), - }, - "Got 2 deltas for extra items" - ); -}; - -done_testing; diff --git a/t/tests/test2/morecompare.t b/t/tests/test2/morecompare.t deleted file mode 100644 index ea85a18..0000000 --- a/t/tests/test2/morecompare.t +++ /dev/null @@ -1,75 +0,0 @@ -#!perl -use strict; -use warnings; -use 5.020; -use Test2::Bundle::Extended; -use lib 't/lib'; -use Test2::Tools::MoreCompare qw(bag call_list); -use Test2::API qw(intercept); - -subtest simple => sub { - imported_ok qw{bag call_list}; -}; - -subtest bag => sub { - my $empty = bag { }; - - my $simple = bag { - item 'a'; - item 'b'; - item 'c'; - }; - - my $closed = array { - item 0 => 'a'; - item 1 => 'b'; - item 2 => 'c'; - end; - }; - - is([], $empty, "empty array"); - is(['a'], $empty, "any array matches empty"); - - is([qw/a b c/], $simple, "simple exact match"); - is([qw/b c a/], $simple, "simple out of order"); - is([qw/a b c d e/], $simple, "simple with extra"); - is([qw/b a d e c/], $simple, "simple with extra, out of order"); - - is([qw/a b c/], $closed, "closed array"); - - my $events = intercept { - is({}, $empty); - is(undef, $empty); - is(1, $empty); - is('ARRAY', $empty); - - is([qw/x y z/], $simple); - is([qw/a b x/], $simple); - is([qw/x b c/], $simple); - - is([qw/a b c d/], $closed); - }; - - @$events = grep {$_->isa('Test2::Event::Ok')} @$events; - is(@$events, 8, "8 events"); - is($_->pass, 0, "event failed") for @$events; -}; - -subtest call_list => sub { - my $obj = mock 'My::Class' => ( - add => [ - many => sub { return (1,2,3) }, - one => sub { 4 }, - ], - ); - - my $calls = object { - call one => 4; - call_list many => [1,2,3]; - call_list one => [4]; - }; - - is(bless({},'My::Class'), $calls, 'call_list matches'); -}; - -done_testing; -- cgit v1.2.3