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::Util::TypeConstraints;
  59
  60 use Mouse::Util::TypeConstraints ();
  61
  62 sub export_type_constraints_as_functions { # TEST ONLY
  63     my $into = caller;
  64
  65     foreach my $type( list_all_type_constraints() ) {
  66         my $tc = find_type_constraint($type)->{_compiled_type_constraint};
  67         my $as = $into . '::' . $type;
  68
  69         no strict 'refs';
  70         *{$as} = sub{ &{$tc} || undef };
  71     }
  72     return;
  73 }
  74
  75 package Mouse::Meta::Attribute;
  76
  77 sub applied_traits{            $_[0]->{traits} } # TEST ONLY
  78 sub has_applied_traits{ exists $_[0]->{traits} } # TEST ONLY
  79
  80 1;
  81
  82 __END__
  83
  84 =pod
  85
  86 =head1 NAME
  87
  88 Test::Mouse - Test functions for Mouse specific features
  89
  90 =head1 SYNOPSIS
  91
  92   use Test::More plan => 1;
  93   use Test::Mouse;
  94
  95   meta_ok($class_or_obj, "... Foo has a ->meta");
  96   does_ok($class_or_obj, $role, "... Foo does the Baz role");
  97   has_attribute_ok($class_or_obj, $attr_name, "... Foo has the 'bar' attribute");
  98
  99 =cut
 100