lib/Test/Moose.pm

   1 package Test::Moose;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Sub::Exporter;
   7 use Test::Builder;
   8
   9 use Moose::Util 'does_role', 'find_meta';
  10
  11 our $VERSION   = '0.57';
  12 $VERSION = eval $VERSION;
  13 our $AUTHORITY = 'cpan:STEVAN';
  14
  15 my @exports = qw[
  16     meta_ok
  17     does_ok
  18     has_attribute_ok
  19 ];
  20
  21 Sub::Exporter::setup_exporter({
  22     exports => \@exports,
  23     groups  => { default => \@exports }
  24 });
  25
  26 ## the test builder instance ...
  27
  28 my $Test = Test::Builder->new;
  29
  30 ## exported functions
  31
  32 sub meta_ok ($;$) {
  33     my ($class_or_obj, $message) = @_;
  34
  35     $message ||= "The object has a meta";
  36
  37     if (find_meta($class_or_obj)) {
  38         return $Test->ok(1, $message)
  39     }
  40     else {
  41         return $Test->ok(0, $message);
  42     }
  43 }
  44
  45 sub does_ok ($$;$) {
  46     my ($class_or_obj, $does, $message) = @_;
  47
  48     $message ||= "The object does $does";
  49
  50     if (does_role($class_or_obj, $does)) {
  51         return $Test->ok(1, $message)
  52     }
  53     else {
  54         return $Test->ok(0, $message);
  55     }
  56 }
  57
  58 sub has_attribute_ok ($$;$) {
  59     my ($class_or_obj, $attr_name, $message) = @_;
  60
  61     $message ||= "The object does has an attribute named $attr_name";
  62
  63     my $meta = find_meta($class_or_obj);
  64
  65     if ($meta->find_attribute_by_name($attr_name)) {
  66         return $Test->ok(1, $message)
  67     }
  68     else {
  69         return $Test->ok(0, $message);
  70     }
  71 }
  72
  73 1;
  74
  75 __END__
  76
  77 =pod
  78
  79 =head1 NAME
  80
  81 Test::Moose - Test functions for Moose specific features
  82
  83 =head1 SYNOPSIS
  84
  85   use Test::More plan => 1;
  86   use Test::Moose;
  87
  88   meta_ok($class_or_obj, "... Foo has a ->meta");
  89   does_ok($class_or_obj, $role, "... Foo does the Baz role");
  90   has_attribute_ok($class_or_obj, $attr_name, "... Foo has the 'bar' attribute");
  91
  92 =head1 DESCRIPTION
  93
  94 This module provides some useful test functions for Moose based classes. It
  95 is an experimental first release, so comments and suggestions are very welcome.
  96
  97 =head1 EXPORTED FUNCTIONS
  98
  99 =over 4
 100
 101 =item B<meta_ok ($class_or_object)>
 102
 103 Tests if a class or object has a metaclass.
 104
 105 =item B<does_ok ($class_or_object, $role, ?$message)>
 106
 107 Tests if a class or object does a certain role, similar to what C<isa_ok>
 108 does for the C<isa> method.
 109
 110 =item B<has_attribute_ok($class_or_object, $attr_name, ?$message)>
 111
 112 Tests if a class or object has a certain attribute, similar to what C<can_ok>
 113 does for the methods.
 114
 115 =back
 116
 117 =head1 TODO
 118
 119 =over 4
 120
 121 =item Convert the Moose test suite to use this module.
 122
 123 =item Here is a list of possible functions to write
 124
 125 =over 4
 126
 127 =item immutability predicates
 128
 129 =item anon-class predicates
 130
 131 =item discovering original method from modified method
 132
 133 =item attribute metaclass predicates (attribute_isa?)
 134
 135 =back
 136
 137 =back
 138
 139 =head1 SEE ALSO
 140
 141 =over 4
 142
 143 =item L<Test::More>
 144
 145 =back
 146
 147 =head1 BUGS
 148
 149 All complex software has bugs lurking in it, and this module is no
 150 exception. If you find a bug please either email me, or add the bug
 151 to cpan-RT.
 152
 153 =head1 AUTHOR
 154
 155 Anders Nor Berle E<lt>debolaz@gmail.comE<gt>
 156
 157 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 158
 159 =head1 COPYRIGHT AND LICENSE
 160
 161 Copyright 2007-2008 by Infinity Interactive, Inc.
 162
 163 L<http://www.iinteractive.com>
 164
 165 This library is free software; you can redistribute it and/or modify
 166 it under the same terms as Perl itself.
 167
 168 =cut
 169