Add some test files
[gitmo/Mouse.git] / t / lib / Test / Mouse.pm
diff --git a/t/lib/Test/Mouse.pm b/t/lib/Test/Mouse.pm
new file mode 100644 (file)
index 0000000..83a5ca0
--- /dev/null
@@ -0,0 +1,72 @@
+package Test::Mouse;\r
+\r
+use strict;\r
+use warnings;\r
+use Mouse::Util qw(find_meta does_role);\r
+\r
+use base qw(Test::Builder::Module);\r
+\r
+our @EXPORT = qw(meta_ok does_ok has_attribute_ok);\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
+    if (does_ok($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 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