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 | |
1b9e472d |
33 | if (does_role($class_or_obj, $does)) { |
b8848347 |
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 | |
993e62a7 |
56 | # Moose compatible methods/functions |
57 | |
739525d0 |
58 | package Mouse::Meta::Module; |
59 | |
60 | sub version { no strict 'refs'; ${shift->name.'::VERSION'} } |
61 | sub authority { no strict 'refs'; ${shift->name.'::AUTHORITY'} } |
62 | sub identifier { |
63 | my $self = shift; |
64 | return join '-' => ( |
65 | $self->name, |
66 | ($self->version || ()), |
67 | ($self->authority || ()), |
68 | ); |
69 | } |
70 | |
71 | |
993e62a7 |
72 | package Mouse::Util::TypeConstraints; |
73 | |
74 | use Mouse::Util::TypeConstraints (); |
75 | |
76 | sub export_type_constraints_as_functions { # TEST ONLY |
77 | my $into = caller; |
78 | |
79 | foreach my $type( list_all_type_constraints() ) { |
3b89ea91 |
80 | my $tc = find_type_constraint($type)->_compiled_type_constraint; |
993e62a7 |
81 | my $as = $into . '::' . $type; |
82 | |
83 | no strict 'refs'; |
84 | *{$as} = sub{ &{$tc} || undef }; |
85 | } |
86 | return; |
87 | } |
88 | |
1b9e472d |
89 | package Mouse::Meta::Attribute; |
90 | |
91 | sub applied_traits{ $_[0]->{traits} } # TEST ONLY |
92 | sub has_applied_traits{ exists $_[0]->{traits} } # TEST ONLY |
93 | |
4060c871 |
94 | sub has_documentation{ exists $_[0]->{documentation} } # TEST ONLY |
95 | sub documentation{ $_[0]->{documentation} } # TEST ONLY |
96 | |
b8848347 |
97 | 1; |
98 | |
99 | __END__ |
100 | |
101 | =pod |
102 | |
103 | =head1 NAME |
104 | |
105 | Test::Mouse - Test functions for Mouse specific features |
106 | |
107 | =head1 SYNOPSIS |
108 | |
109 | use Test::More plan => 1; |
110 | use Test::Mouse; |
111 | |
112 | meta_ok($class_or_obj, "... Foo has a ->meta"); |
113 | does_ok($class_or_obj, $role, "... Foo does the Baz role"); |
114 | has_attribute_ok($class_or_obj, $attr_name, "... Foo has the 'bar' attribute"); |
115 | |
116 | =cut |
117 | |