lib/Test/Mouse.pm

   1 package Test::Mouse;
   2
   3 use Mouse::Exporter;
   4 use Mouse::Util qw(does_role find_meta);
   5
   6 use Test::Builder;
   7
   8 Mouse::Exporter->setup_import_methods(
   9     as_is => [qw(
  10         meta_ok
  11         does_ok
  12         has_attribute_ok
  13     )],
  14 );
  15
  16 ## the test builder instance ...
  17
  18 my $Test = Test::Builder->new;
  19
  20 ## exported functions
  21
  22 sub meta_ok ($;$) {
  23     my ($class_or_obj, $message) = @_;
  24
  25     $message ||= "The object has a meta";
  26
  27     if (find_meta($class_or_obj)) {
  28         return $Test->ok(1, $message)
  29     }
  30     else {
  31         return $Test->ok(0, $message);
  32     }
  33 }
  34
  35 sub does_ok ($$;$) {
  36     my ($class_or_obj, $does, $message) = @_;
  37
  38     $message ||= "The object does $does";
  39
  40     if (does_role($class_or_obj, $does)) {
  41         return $Test->ok(1, $message)
  42     }
  43     else {
  44         return $Test->ok(0, $message);
  45     }
  46 }
  47
  48 sub has_attribute_ok ($$;$) {
  49     my ($class_or_obj, $attr_name, $message) = @_;
  50
  51     $message ||= "The object does has an attribute named $attr_name";
  52
  53     my $meta = find_meta($class_or_obj);
  54
  55     if ($meta->find_attribute_by_name($attr_name)) {
  56         return $Test->ok(1, $message)
  57     }
  58     else {
  59         return $Test->ok(0, $message);
  60     }
  61 }
  62
  63 1;
  64 __END__
  65
  66 =head1 NAME
  67
  68 Test::Mouse - Test functions for Mouse specific features
  69
  70 =head1 SYNOPSIS
  71
  72   use Test::More plan => 1;
  73   use Test::Mouse;
  74
  75   meta_ok($class_or_obj, "... Foo has a ->meta");
  76   does_ok($class_or_obj, $role, "... Foo does the Baz role");
  77   has_attribute_ok($class_or_obj, $attr_name, "... Foo has the 'bar' attribute");
  78
  79 =head1 DESCRIPTION
  80
  81 This module provides some useful test functions for Mouse based classes. It
  82 is an experimental first release, so comments and suggestions are very welcome.
  83
  84 =head1 EXPORTED FUNCTIONS
  85
  86 =over 4
  87
  88 =item B<meta_ok ($class_or_object)>
  89
  90 Tests if a class or object has a metaclass.
  91
  92 =item B<does_ok ($class_or_object, $role, ?$message)>
  93
  94 Tests if a class or object does a certain role, similar to what C<isa_ok>
  95 does for the C<isa> method.
  96
  97 =item B<has_attribute_ok($class_or_object, $attr_name, ?$message)>
  98
  99 Tests if a class or object has a certain attribute, similar to what C<can_ok>
 100 does for the methods.
 101
 102 =back
 103
 104 =head1 SEE ALSO
 105
 106 =over 4
 107
 108 =item L<Test::More>
 109
 110 =back
 111
 112 =head1 SEE ALSO
 113
 114 L<Mouse>
 115
 116 L<Test::Moose>
 117
 118 =cut
 119