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