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