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