Changelogging

[gitmo/Mouse.git] / lib / Test / Mouse.pm

package Test::Mouse;\r
\r
use strict;\r
use warnings;\r
use Mouse ();\r
\r
use base qw(Test::Builder::Module);\r
\r
our @EXPORT = qw(meta_ok does_ok has_attribute_ok);\r
\r
sub find_meta{ Mouse::class_of($class_or_obj) }\r
\r
sub meta_ok ($;$) {\r
    my ($class_or_obj, $message) = @_;\r
\r
    $message ||= "The object has a meta";\r
\r
    if (find_meta($class_or_obj)) {\r
        return __PACKAGE__->builder->ok(1, $message)\r
    }\r
    else {\r
        return __PACKAGE__->builder->ok(0, $message);\r
    }\r
}\r
\r
sub does_ok ($$;$) {\r
    my ($class_or_obj, $does, $message) = @_;\r
\r
    $message ||= "The object does $does";\r
\r
    my $meta = find_meta($class_or_obj);\r
    if ($meta && $meta->does_role($does)) {\r
        return __PACKAGE__->builder->ok(1, $message)\r
    }\r
    else {\r
        return __PACKAGE__->builder->ok(0, $message);\r
    }\r
}\r
\r
sub has_attribute_ok ($$;$) {\r
    my ($class_or_obj, $attr_name, $message) = @_;\r
\r
    $message ||= "The object does has an attribute named $attr_name";\r
\r
    my $meta = find_meta($class_or_obj);\r
\r
    if ($meta->find_attribute_by_name($attr_name)) {\r
        return __PACKAGE__->builder->ok(1, $message)\r
    }\r
    else {\r
        return __PACKAGE__->builder->ok(0, $message);\r
    }\r
}\r
\r
1;\r
\r
__END__\r
\r
=pod\r
\r
=head1 NAME\r
\r
Test::Mouse - Test functions for Mouse specific features\r
\r
=head1 SYNOPSIS\r
\r
  use Test::More plan => 1;\r
  use Test::Mouse;\r
\r
  meta_ok($class_or_obj, "... Foo has a ->meta");\r
  does_ok($class_or_obj, $role, "... Foo does the Baz role");\r
  has_attribute_ok($class_or_obj, $attr_name, "... Foo has the 'bar' attribute");\r
\r
=cut\r
\r