t/lib/Test/Mouse.pm

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