t/lib/Test/Mouse.pm

   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
  33     if (does_ok($class_or_obj)) {
  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
  56 1;
  57
  58 __END__
  59
  60 =pod
  61
  62 =head1 NAME
  63
  64 Test::Mouse - Test functions for Mouse specific features
  65
  66 =head1 SYNOPSIS
  67
  68   use Test::More plan => 1;
  69   use Test::Mouse;
  70
  71   meta_ok($class_or_obj, "... Foo has a ->meta");
  72   does_ok($class_or_obj, $role, "... Foo does the Baz role");
  73   has_attribute_ok($class_or_obj, $attr_name, "... Foo has the 'bar' attribute");
  74
  75 =cut
  76