package Test::Moose; use strict; use warnings; use Sub::Exporter; use Test::Builder; use Moose::Util 'does_role', 'find_meta'; our $VERSION = '0.01'; our $AUTHORITY = 'cpan:STEVAN'; my @exports = qw[ meta_ok does_ok has_attribute_ok ]; Sub::Exporter::setup_exporter({ exports => \@exports, groups => { default => \@exports } }); ## the test builder instance ... my $Test = Test::Builder->new; ## exported functions sub meta_ok ($;$) { my ($class_or_obj, $message) = @_; $message ||= "The object has a meta"; if (find_meta($class_or_obj)) { return $Test->ok(1, $message) } else { return $Test->ok(0, $message); } } sub does_ok ($$;$) { my ($class_or_obj, $does, $message) = @_; $message ||= "The object does $does"; if (does_role($class_or_obj, $does)) { return $Test->ok(1, $message) } else { return $Test->ok(0, $message); } } sub has_attribute_ok ($$;$) { my ($class_or_obj, $attr_name, $message) = @_; $message ||= "The object does has an attribute named $attr_name"; my $meta = find_meta($class_or_obj); if ($meta->find_attribute_by_name($attr_name)) { return $Test->ok(1, $message) } else { return $Test->ok(0, $message); } } 1; __END__ =pod =head1 NAME Test::Moose - Test functions for Moose specific features =head1 SYNOPSIS use Test::More plan => 1; use Test::Moose; meta_ok($class_or_obj, "... Foo has a ->meta"); does_ok($class_or_obj, $role, "... Foo does the Baz role"); has_attribute_ok($class_or_obj, $attr_name, "... Foo has the 'bar' attribute"); =head1 DESCRIPTION This module provides some useful test functions for Moose based classes. It is an experimental first release, so comments and suggestions are very welcome. =head1 EXPORTED FUNCTIONS =over 4 =item B Tests if a class or object has a metaclass. =item B Tests if a class or object does a certain role, similar to what C does for the C method. =item B Tests if a class or object has a certain attribute, similar to what C does for the methods. =back =head1 TODO =over 4 =item Convert the Moose test suite to use this module. =item Here is a list of possible functions to write =over 4 =item immutability predicates =item anon-class predicates =item discovering original method from modified method =item attribute metaclass predicates (attribute_isa?) =back =back =head1 SEE ALSO =over 4 =item L =back =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Anders Nor Berle Edebolaz@gmail.comE Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2007-2008 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut