Skip to content
Browse files

Add tests, required_methods testing to validate_role

  • Loading branch information...
1 parent 71d8bb8 commit d59431395771457a5abf37d823e554f50d80cec1 @RsrchBoy committed
Showing with 163 additions and 25 deletions.
  1. +49 −25 lib/Test/Moose/More.pm
  2. +114 −0 t/validate_role.t
View
74 lib/Test/Moose/More.pm
@@ -244,55 +244,76 @@ sub check_sugar_ok {
}
-=test validate_class
+=test validate_thing
+
+Runs a bunch of tests against the given C<$thing>, as defined:
+
+ validate_class $thing => (
-validate_class 'Some::Class' => (
+ attributes => [ ... ],
+ methods => [ ... ],
+ isa => [ ... ],
- attributes => [ ... ],
- methods => [ ... ],
- isa => [ ... ],
+ # ensures $thing does these roles
+ does => [ ... ],
- # ensures class does these roles
- does => [ ... ],
+ # ensures $thing does not do these roles
+ does_not => [ ... ],
+ );
- # ensures class does not do these roles
- does_not => [ ... ],
-);
+C<$thing> can be the name of a role or class, an object instance, or a
+metaclass.
=test validate_role
-The same as validate_class(), but for roles.
+The same as validate_thing(), but ensures C<$thing> is a role, and allows for
+additional role-specific tests.
-=test validate_thing
+ validate_role $thing => (
+
+ required_methods => [ ... ],
+
+ # ...and all other options from validate_thing()
+
+=test validate_class
-The same as validate_class() and validate_role(), except without the class or
-role validation.
+The same as validate_thing(), but ensures C<$thing> is a class, and allows for
+additional class-specific tests.
=cut
sub validate_thing {
- my ($class, %args) = @_;
+ my ($thing, %args) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
### roles...
- do { does_ok($class, $_) for @{$args{does}} }
+ do { does_ok($thing, $_) for @{$args{does}} }
if exists $args{does};
- do { does_not_ok($class, $_) for @{$args{does_not}} }
+ do { does_not_ok($thing, $_) for @{$args{does_not}} }
if exists $args{does_not};
### methods...
- do { has_method_ok($class, $_) for @{$args{methods}} }
+ do { has_method_ok($thing, $_) for @{$args{methods}} }
if exists $args{methods};
### attributes...
+ ATTRIBUTE_LOOP:
for my $attribute (@{Data::OptList::mkopt($args{attributes} || [])}) {
my ($name, $opts) = @$attribute;
- has_attribute_ok($class, $name);
- local $THING_NAME = "${class}'s attribute $name";
- validate_thing(find_meta($class)->get_attribute($name), %$opts)
- if $opts;
+ has_attribute_ok($thing, $name);
+
+ if ($opts) {
+
+ SKIP: {
+ skip 'Cannot examine attribute metaclass in roles', 1
+ if (find_meta($thing)->isa('Moose::Meta::Role'));
+
+ local $THING_NAME = "${thing}'s attribute $name";
+ validate_thing(find_meta($thing)->get_attribute($name), %$opts);
+ }
+ }
}
return;
@@ -311,12 +332,15 @@ sub validate_class {
}
sub validate_role {
- my ($class, %args) = @_;
+ my ($role, %args) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
- return unless is_role $class;
+ return unless is_role $role;
- return validate_thing $class => %args;
+ requires_method_ok($role => @{ $args{required_methods} })
+ if defined $args{required_methods};
+
+ return validate_thing $role => %args;
}
!!42;
View
114 t/validate_role.t
@@ -0,0 +1,114 @@
+use strict;
+use warnings;
+
+{ package TestRole::One; use Moose::Role; }
+{ package TestRole::Two; use Moose::Role; }
+{ package TestRole::Invalid; use Moose::Role; with 'TestRole::Two'; }
+{ package TestClass::NonMoosey; }
+
+{
+ package TestRole;
+ use Moose::Role;
+ use MooseX::AttributeShortcuts;
+
+ with 'TestRole::One';
+
+ has foo => (is => 'ro');
+
+ has baz => (traits => ['TestRole::Two'], is => 'ro');
+
+ sub method1 { }
+
+ requires 'blargh';
+
+ has bar => (
+
+ traits => ['Array'],
+ isa => 'ArrayRef',
+ is => 'lazy',
+
+ handles => {
+
+ has_bar => 'count',
+ num_bars => 'count',
+ }
+ );
+}
+
+use Test::Builder::Tester; # tests => 1;
+use Test::More;
+use Test::Moose::More;
+
+require 't/funcs.pm' unless eval { require funcs };
+
+note 'validate w/valid role';
+{
+ my ($_ok, $_nok) = counters();
+ test_out $_ok->('TestRole has a metaclass');
+ test_out $_ok->('TestRole is a Moose role');
+ test_out $_ok->('TestRole requires method blargh');
+ test_out $_ok->('TestRole does TestRole');
+ test_out $_ok->('TestRole does not do TestRole::Two');
+ test_out $_ok->("TestRole has method $_")
+ for qw{ method1 };
+ test_out $_ok->('TestRole has an attribute named bar');
+ validate_role 'TestRole' => (
+ attributes => [ 'bar' ],
+ does => [ 'TestRole' ],
+ does_not => [ 'TestRole::Two' ],
+ # XXX cannot check for accessor methods in a role at the moment
+ #methods => [ qw{ foo method1 has_bar } ],
+ methods => [ qw{ method1 } ],
+ required_methods => [ qw{ blargh } ],
+ );
+ test_test 'validate_role works correctly for valid roles';
+}
+
+note 'validate w/non-moose package';
+{
+ my ($_ok, $_nok) = counters();
+ test_out $_nok->('TestClass::NonMoosey has a metaclass');
+ test_fail 1;
+ validate_role 'TestClass::NonMoosey' => (
+ does => [ 'TestRole' ],
+ methods => [ qw{ foo method1 has_bar } ],
+ );
+ test_test 'validate_role works correctly for non-moose classes';
+}
+
+note 'validate invalid role';
+{
+ my ($_ok, $_nok) = counters();
+
+ test_out $_ok->('TestRole::Invalid has a metaclass');
+ test_out $_ok->('TestRole::Invalid is a Moose role');
+ test_out $_nok->('TestRole::Invalid does TestRole');
+ test_fail 6;
+ test_out $_nok->('TestRole::Invalid does not do TestRole::Two');
+ test_fail 4;
+ do { test_out $_nok->("TestRole::Invalid has method $_"); test_fail 3 }
+ for qw{ foo method1 has_bar };
+
+ validate_role 'TestRole::Invalid' => (
+ does => [ 'TestRole' ],
+ does_not => [ 'TestRole::Two' ],
+ methods => [ qw{ foo method1 has_bar } ],
+ );
+ test_test 'validate_role works correctly for invalid roles';
+}
+
+note 'validate w/attribute validation';
+{
+ my ($_ok, $_nok, $_skip) = counters();
+ test_out $_ok->('TestRole has a metaclass');
+ test_out $_ok->('TestRole is a Moose role');
+ test_out $_ok->('TestRole has an attribute named bar');
+ test_out $_ok->('TestRole has an attribute named baz');
+ test_out $_skip->(q{Cannot examine attribute metaclass in roles});
+ test_out $_ok->('TestRole has an attribute named foo');
+ validate_role 'TestRole' => (
+ attributes => [ 'bar', baz => { does => [ 'TestRole::Two' ] }, 'foo' ],
+ );
+ test_test 'validate_role works correctly for attribute meta checking';
+}
+done_testing;

0 comments on commit d594313

Please sign in to comment.
Something went wrong with that request. Please try again.