t/lib/Test/Mouse.pm

   1 package Test::Mouse;
   2
   3 use strict;
   4 use warnings;
   5 use Carp qw(croak);
   6 use Mouse::Util qw(find_meta does_role);
   7
   8 use base qw(Test::Builder::Module);
   9
  10 our @EXPORT = qw(meta_ok does_ok has_attribute_ok);
  11
  12 sub meta_ok ($;$) {
  13     my ($class_or_obj, $message) = @_;
  14
  15     $message ||= "The object has a meta";
  16
  17     if (find_meta($class_or_obj)) {
  18         return __PACKAGE__->builder->ok(1, $message)
  19     }
  20     else {
  21         return __PACKAGE__->builder->ok(0, $message);
  22     }
  23 }
  24
  25 sub does_ok ($$;$) {
  26     my ($class_or_obj, $does, $message) = @_;
  27
  28     if(!defined $does){
  29         croak "You must pass a role name";
  30     }
  31     $message ||= "The object does $does";
  32
  33     if (does_role($class_or_obj, $does)) {
  34         return __PACKAGE__->builder->ok(1, $message)
  35     }
  36     else {
  37         return __PACKAGE__->builder->ok(0, $message);
  38     }
  39 }
  40
  41 sub has_attribute_ok ($$;$) {
  42     my ($class_or_obj, $attr_name, $message) = @_;
  43
  44     $message ||= "The object does has an attribute named $attr_name";
  45
  46     my $meta = find_meta($class_or_obj);
  47
  48     if ($meta->find_attribute_by_name($attr_name)) {
  49         return __PACKAGE__->builder->ok(1, $message)
  50     }
  51     else {
  52         return __PACKAGE__->builder->ok(0, $message);
  53     }
  54 }
  55
  56 # Moose compatible methods/functions
  57
  58 package Mouse::Meta::Module;
  59
  60 sub version   { no strict 'refs'; ${shift->name.'::VERSION'}   }
  61 sub authority { no strict 'refs'; ${shift->name.'::AUTHORITY'} }
  62 sub identifier {
  63     my $self = shift;
  64     return join '-' => (
  65        $self->name,
  66         ($self->version   || ()),
  67         ($self->authority || ()),
  68     );
  69 }
  70
  71
  72 package Mouse::Util::TypeConstraints;
  73
  74 use Mouse::Util::TypeConstraints ();
  75
  76 sub export_type_constraints_as_functions { # TEST ONLY
  77     my $into = caller;
  78
  79     foreach my $type( list_all_type_constraints() ) {
  80         my $tc = find_type_constraint($type)->_compiled_type_constraint;
  81         my $as = $into . '::' . $type;
  82
  83         no strict 'refs';
  84         *{$as} = sub{ &{$tc} || undef };
  85     }
  86     return;
  87 }
  88
  89 package Mouse::Meta::Attribute;
  90
  91 sub applied_traits{            $_[0]->{traits} } # TEST ONLY
  92 sub has_applied_traits{ exists $_[0]->{traits} } # TEST ONLY
  93
  94 1;
  95
  96 __END__
  97
  98 =pod
  99
 100 =head1 NAME
 101
 102 Test::Mouse - Test functions for Mouse specific features
 103
 104 =head1 SYNOPSIS
 105
 106   use Test::More plan => 1;
 107   use Test::Mouse;
 108
 109   meta_ok($class_or_obj, "... Foo has a ->meta");
 110   does_ok($class_or_obj, $role, "... Foo does the Baz role");
 111   has_attribute_ok($class_or_obj, $attr_name, "... Foo has the 'bar' attribute");
 112
 113 =cut
 114