diff --git a/lib/Test2/Compare/Meta.pm b/lib/Test2/Compare/Meta.pm index ab545e08f..70874137a 100644 --- a/lib/Test2/Compare/Meta.pm +++ b/lib/Test2/Compare/Meta.pm @@ -4,6 +4,7 @@ use warnings; use Test2::Compare::Delta(); use Test2::Compare::Isa(); +use Test2::Compare::Role(); use base 'Test2::Compare::Base'; @@ -54,6 +55,19 @@ sub add_prop { $check = Test2::Compare::Isa->new(input => $check); } } + if ($name eq 'role') { # + if (blessed($check) && $check->isa('Test2::Compare::Wildcard')) { + # Carry forward file and lines that are set in Test2::Tools::Compare::prop. + $check = Test2::Compare::Role->new( + input => $check->expect, + file => $check->file, + lines => $check->lines, + ); + } + else { + $check = Test2::Compare::Role->new(input => $check); + } + } push @{$self->{+ITEMS}} => [$meth, $check, $name]; } @@ -103,6 +117,8 @@ sub get_prop_size { return undef; } +sub get_prop_role { $_[1] } + 1; __END__ @@ -148,6 +164,11 @@ Lets you check the size of the item. For an arrayref this is the number of elements. For a hashref this is the number of keys. For everything else this is undef. +=item role + +Lets you check if the item has the expected role composed. It uses +L to achieve this. + =back =head1 SOURCE diff --git a/lib/Test2/Compare/Role.pm b/lib/Test2/Compare/Role.pm new file mode 100644 index 000000000..2f5e29839 --- /dev/null +++ b/lib/Test2/Compare/Role.pm @@ -0,0 +1,100 @@ +package Test2::Compare::Role; +use strict; +use warnings; + +use Carp qw/confess/; +use Scalar::Util qw/blessed/; + +use base 'Test2::Compare::Base'; + +our $VERSION = '1.302220'; + +use Test2::Util::HashBase qw/input/; + +# Overloads '!' for us. +use Test2::Compare::Negatable; + +sub init { + my $self = shift; + confess "input must be defined for 'Role' check" unless defined $self->{+INPUT}; + + $self->SUPER::init(@_); +} + +sub name { + my $self = shift; + my $in = $self->{+INPUT}; + return "$in"; +} + +sub operator { + my $self = shift; + return '!role' if $self->{+NEGATE}; + return 'role'; +} + +sub verify { + my $self = shift; + my %params = @_; + my ($got, $exists) = @params{qw/got exists/}; + + return 0 unless $exists; + return 0 unless eval { require Role::Tiny; 1 }; + + my $input = $self->{+INPUT}; + my $negate = $self->{+NEGATE}; + my $role = Role::Tiny::does_role($got, $input); + + return !$role if $negate; + return $role; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Test2::Compare::Role - Check if the value does the role. + +=head1 DESCRIPTION + +This is used to check if the got value does the expected role. + +=head1 SOURCE + +The source code repository for Test2-Suite can be found at +F. + +=head1 MAINTAINERS + +=over 4 + +=item Chad Granum Eexodist@cpan.orgE + +=back + +=head1 AUTHORS + +=over 4 + +=item Chad Granum Eexodist@cpan.orgE + +=item TOYAMA Nao Enanto@moon.email.ne.jpE + +=back + +=head1 COPYRIGHT + +Copyright Chad Granum Eexodist@cpan.orgE. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See F + +=cut diff --git a/lib/Test2/Tools/Compare.pm b/lib/Test2/Tools/Compare.pm index 355665e22..b7b57caf0 100644 --- a/lib/Test2/Tools/Compare.pm +++ b/lib/Test2/Tools/Compare.pm @@ -1545,6 +1545,7 @@ B prop isa => 'My::Base'; # Ensure value is an instance of our class prop size => 4; # Check the number of hash keys prop this => ...; # Check the item itself + prop role => 'My::Role'; # Ensure value does the role (if using Role::Tiny) }; =over 4 @@ -1588,6 +1589,11 @@ The thing itself. For array references this returns the number of elements. For hashes this returns the number of keys. For everything else this returns undef. +=item 'role' + +Check if the item has the expected role composed. It uses +L to achieve this. + =back =back @@ -1734,6 +1740,11 @@ The thing itself. For array references this returns the number of elements. For hashes this returns the number of keys. For everything else this returns undef. +=item 'role' + +Check if the item has the expected role composed. It uses +L to achieve this. + =back =item DNE() diff --git a/t/modules/Compare/Meta.t b/t/modules/Compare/Meta.t index aa04b036e..981597085 100644 --- a/t/modules/Compare/Meta.t +++ b/t/modules/Compare/Meta.t @@ -87,4 +87,38 @@ subtest deltas => sub { ); }; +{ + + package Foo::Role { + use Role::Tiny; + }; + + package Foo::Quux { + use Role::Tiny::With; + with 'Foo::Role'; + }; +} + +subtest role => sub { + my $one = $CLASS->new(); + $one->add_prop('reftype' => 'HASH'); + $one->add_prop('role' => 'Foo::Role'); + my $foo_quux = bless {}, 'Foo::Quux'; + my $foo = bless {}, 'Foo'; + is([$one->deltas(got => $foo_quux, convert => \&convert, seen => {})], [], 'does have the role'); + like( + [ + $one->deltas( + got => $foo, + convert => \&convert, + seen => {} + ) + ], + [ + {verified => F(), got => $foo, children => [], id => ['META' => 'role']}, + ], + "does not have the role" + ); +}; + done_testing; diff --git a/t/modules/Compare/Role.t b/t/modules/Compare/Role.t new file mode 100644 index 000000000..2549e0b5b --- /dev/null +++ b/t/modules/Compare/Role.t @@ -0,0 +1,81 @@ +use Test2::Bundle::Extended -target => 'Test2::Compare::Role'; + +plan skip_all => 'Role::Tiny is required for Role checks' unless eval { require Role::Tiny; 1 }; + +{ + + package Foo { }; + + package Foo::Role { + use Role::Tiny; + }; + + package Foo::Role::Over { + use Role::Tiny; + }; + + package Foo::Bar { + use Role::Tiny::With; + with 'Foo::Role'; + }; + + package Foo::Quux { + use Role::Tiny::With; + with 'Foo::Role', 'Foo::Role::Over'; + }; + + package Baz { }; +} + +my $role_foo = $CLASS->new(input => 'Foo::Role'); +my $role_foo_over = $CLASS->new(input => 'Foo::Role::Over'); +my $not_role_foo = $CLASS->new(input => 'Foo::Role', negate => 1); + +isa_ok($_, $CLASS, 'Test2::Compare::Base') for $role_foo, $role_foo_over, $not_role_foo; + +subtest name => sub { + is($role_foo->name, 'Foo::Role', "got expected name"); + is($role_foo_over->name, 'Foo::Role::Over', "got expected name"); + is($not_role_foo->name, 'Foo::Role', "got expected name"); +}; + +subtest operator => sub { + is($role_foo->operator, 'role', "got expected operator"); + is($role_foo_over->operator, 'role', "got expected operator"); + is($not_role_foo->operator, '!role', "got expected operator"); +}; + +subtest verify => sub { + my $foo = bless {}, 'Foo'; + my $foo_bar = bless {}, 'Foo::Bar'; + my $foo_quux = bless {}, 'Foo::Quux'; + my $baz = bless {}, 'Baz'; + + ok(!$role_foo->verify(exists => 0, got => undef), 'does not verify against DNE'); + ok(!$role_foo->verify(exists => 1, got => undef), 'undef has no role Foo::Role'); + ok(!$role_foo->verify(exists => 1, got => 42), '42 has no role Foo::Role'); + ok(!$role_foo->verify(exists => 1, got => $foo), '$foo has no role Foo::Role'); + ok($role_foo->verify(exists => 1, got => $foo_bar), '$foo_bar has role Foo::Role'); + ok($role_foo->verify(exists => 1, got => $foo_quux), '$foo_quux has role Foo::Role'); + ok(!$role_foo->verify(exists => 1, got => $baz), '$baz has no role Foo::Role'); + + ok(!$role_foo_over->verify(exists => 0, got => undef), 'does not verify against DNE'); + ok(!$role_foo_over->verify(exists => 1, got => undef), 'undef has no role Foo::Role::Over'); + ok(!$role_foo_over->verify(exists => 1, got => 42), '42 has no role Foo::Role::Over'); + ok(!$role_foo_over->verify(exists => 1, got => $foo), '$foo has no role Foo::Role::Over'); + ok(!$role_foo_over->verify(exists => 1, got => $foo_bar), '$foo_bar has no role Foo::Role::Over'); + ok($role_foo_over->verify(exists => 1, got => $foo_quux), '$foo_quux has role Foo::Role::Over'); + ok(!$role_foo_over->verify(exists => 1, got => $baz), '$baz has no role Foo::Role::Over'); + + ok(!$not_role_foo->verify(exists => 0, got => undef), 'does not verify against DNE'); + ok($not_role_foo->verify(exists => 1, got => undef), 'undef has no role Foo::Role'); + ok($not_role_foo->verify(exists => 1, got => 42), '42 has no role Foo::Role'); + ok($not_role_foo->verify(exists => 1, got => $foo), '$foo has no role Foo::Role'); + ok(!$not_role_foo->verify(exists => 1, got => $foo_bar), '$foo_bar has role Foo::Role'); + ok(!$not_role_foo->verify(exists => 1, got => $foo_quux), '$foo_quux has role Foo::Role'); + ok($not_role_foo->verify(exists => 1, got => $baz), '$baz has no role Foo::Role'); +}; + +like(dies { $CLASS->new() }, qr/input must be defined for 'Role' check/, "Cannot use undef as a class name"); + +done_testing;