t/lib/Test/Mouse.pm

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