Commit | Line | Data |
b8848347 |
1 | package Test::Mouse; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | use Carp qw(croak); |
6 | use Mouse::Util qw(find_meta does_role); |
7 | |
8 | use base qw(Test::Builder::Module); |
9 | |
10 | our @EXPORT = qw(meta_ok does_ok has_attribute_ok); |
11 | |
12 | sub meta_ok ($;$) { |
13 | my ($class_or_obj, $message) = @_; |
14 | |
15 | $message ||= "The object has a meta"; |
16 | |
17 | if (find_meta($class_or_obj)) { |
18 | return __PACKAGE__->builder->ok(1, $message) |
19 | } |
20 | else { |
21 | return __PACKAGE__->builder->ok(0, $message); |
22 | } |
23 | } |
24 | |
25 | sub does_ok ($$;$) { |
26 | my ($class_or_obj, $does, $message) = @_; |
27 | |
28 | if(!defined $does){ |
29 | croak "You must pass a role name"; |
30 | } |
31 | $message ||= "The object does $does"; |
32 | |
33 | if (does_ok($class_or_obj)) { |
34 | return __PACKAGE__->builder->ok(1, $message) |
35 | } |
36 | else { |
37 | return __PACKAGE__->builder->ok(0, $message); |
38 | } |
39 | } |
40 | |
41 | sub has_attribute_ok ($$;$) { |
42 | my ($class_or_obj, $attr_name, $message) = @_; |
43 | |
44 | $message ||= "The object does has an attribute named $attr_name"; |
45 | |
46 | my $meta = find_meta($class_or_obj); |
47 | |
48 | if ($meta->find_attribute_by_name($attr_name)) { |
49 | return __PACKAGE__->builder->ok(1, $message) |
50 | } |
51 | else { |
52 | return __PACKAGE__->builder->ok(0, $message); |
53 | } |
54 | } |
55 | |
56 | 1; |
57 | |
58 | __END__ |
59 | |
60 | =pod |
61 | |
62 | =head1 NAME |
63 | |
64 | Test::Mouse - Test functions for Mouse specific features |
65 | |
66 | =head1 SYNOPSIS |
67 | |
68 | use Test::More plan => 1; |
69 | use Test::Mouse; |
70 | |
71 | meta_ok($class_or_obj, "... Foo has a ->meta"); |
72 | does_ok($class_or_obj, $role, "... Foo does the Baz role"); |
73 | has_attribute_ok($class_or_obj, $attr_name, "... Foo has the 'bar' attribute"); |
74 | |
75 | =cut |
76 | |