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 List::MoreUtils 'all';
  10 use Moose::Util 'does_role', 'find_meta';
  11
  12 my @exports = qw[
  13     meta_ok
  14     does_ok
  15     has_attribute_ok
  16     with_immutable
  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 sub with_immutable (&@) {
  72     my $block = shift;
  73     my $before = $Test->current_test;
  74     $block->();
  75     Class::MOP::class_of($_)->make_immutable for @_;
  76     $block->();
  77     my $num_tests = $Test->current_test - $before;
  78     return all { $_ } ($Test->summary)[-$num_tests..-1];
  79 }
  80
  81 1;
  82
  83 # ABSTRACT: Test functions for Moose specific features
  84
  85 __END__
  86
  87 =pod
  88
  89 =head1 SYNOPSIS
  90
  91   use Test::More plan => 1;
  92   use Test::Moose;
  93
  94   meta_ok($class_or_obj, "... Foo has a ->meta");
  95   does_ok($class_or_obj, $role, "... Foo does the Baz role");
  96   has_attribute_ok($class_or_obj, $attr_name, "... Foo has the 'bar' attribute");
  97
  98 =head1 DESCRIPTION
  99
 100 This module provides some useful test functions for Moose based classes. It
 101 is an experimental first release, so comments and suggestions are very welcome.
 102
 103 =head1 EXPORTED FUNCTIONS
 104
 105 =over 4
 106
 107 =item B<meta_ok ($class_or_object)>
 108
 109 Tests if a class or object has a metaclass.
 110
 111 =item B<does_ok ($class_or_object, $role, ?$message)>
 112
 113 Tests if a class or object does a certain role, similar to what C<isa_ok>
 114 does for the C<isa> method.
 115
 116 =item B<has_attribute_ok($class_or_object, $attr_name, ?$message)>
 117
 118 Tests if a class or object has a certain attribute, similar to what C<can_ok>
 119 does for the methods.
 120
 121 =item B<with_immutable { CODE } @class_names>
 122
 123 Runs B<CODE> (which should contain normal tests) twice, and make each
 124 class in C<@class_names> immutable in between the two runs.
 125
 126 =back
 127
 128 =head1 TODO
 129
 130 =over 4
 131
 132 =item Convert the Moose test suite to use this module.
 133
 134 =item Here is a list of possible functions to write
 135
 136 =over 4
 137
 138 =item immutability predicates
 139
 140 =item anon-class predicates
 141
 142 =item discovering original method from modified method
 143
 144 =item attribute metaclass predicates (attribute_isa?)
 145
 146 =back
 147
 148 =back
 149
 150 =head1 SEE ALSO
 151
 152 =over 4
 153
 154 =item L<Test::More>
 155
 156 =back
 157
 158 =head1 BUGS
 159
 160 See L<Moose/BUGS> for details on reporting bugs.
 161
 162 =cut
 163