Add some test files
gfx [Tue, 22 Sep 2009 02:41:08 +0000 (11:41 +0900)]
t/lib/Role/Child.pm [new file with mode: 0644]
t/lib/Role/Interface.pm [new file with mode: 0644]
t/lib/Role/Parent.pm [new file with mode: 0644]
t/lib/Test/Mouse.pm [new file with mode: 0644]

diff --git a/t/lib/Role/Child.pm b/t/lib/Role/Child.pm
new file mode 100644 (file)
index 0000000..323eaa1
--- /dev/null
@@ -0,0 +1,8 @@
+package Role::Child;
+use Mouse::Role;
+
+with 'Role::Parent' => { alias => { meth1 => 'aliased_meth1', } };
+
+sub meth1 { }
+
+1;
diff --git a/t/lib/Role/Interface.pm b/t/lib/Role/Interface.pm
new file mode 100644 (file)
index 0000000..f081f32
--- /dev/null
@@ -0,0 +1,6 @@
+package Role::Interface;
+use Mouse::Role;
+
+requires "meth2";
+
+1;
diff --git a/t/lib/Role/Parent.pm b/t/lib/Role/Parent.pm
new file mode 100644 (file)
index 0000000..04befab
--- /dev/null
@@ -0,0 +1,7 @@
+package Role::Parent;
+use Mouse::Role;
+
+sub meth2  { }
+sub meth1 { }
+
+1;
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