From: Fuji, Goro <gfuji@cpan.org>
Date: Fri, 24 Sep 2010 04:37:44 +0000 (+0900)
Subject: Add some testing stuff to t/lib/MooseCompat.pm
X-Git-Tag: 0.71~12
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=77e324adcc3f027a2636432e622ff0594a9408b8;p=gitmo%2FMouse.git

Add some testing stuff to t/lib/MooseCompat.pm
---

diff --git a/t/lib/MooseCompat.pm b/t/lib/MooseCompat.pm
index 19ae7cb..a936683 100644
--- a/t/lib/MooseCompat.pm
+++ b/t/lib/MooseCompat.pm
@@ -1,5 +1,32 @@
 package MooseCompat;
 # Moose compatible methods/functions
+use Mouse ();
+use Mouse::Util::MetaRole;
+use Mouse::Meta::Method;
+use Mouse::Meta::Role::Method;
+
+$INC{'Mouse/Meta.pm'}          = __FILE__;
+$INC{'Mouse/Meta/Instance.pm'} = __FILE__;
+$INC{'Mouse/Deprecated.pm'}    = __FILE__;
+
+sub UNIVERSAL::DOES {
+    my($thing, $role) = @_;
+    $thing->isa($role) || Mouse::Util::does_role($thing, $role);
+}
+
+$Mouse::Deprecated::deprecated = $Mouse::Deprecated::deprecated = undef; # -w
+
+package Mouse::Util;
+
+sub resolve_metatrait_alias {
+    return resolve_metaclass_alias( @_, trait => 1);
+}
+
+sub ensure_all_roles {
+    my $consumer = shift;
+    apply_all_roles($consumer, grep { !does_role($appicant, $_) } @_);
+    return;
+}
 
 package Mouse::Meta::Module;
 
@@ -14,6 +41,8 @@ sub identifier {
     );
 }
 
+sub role_applications { }
+
 package Mouse::Meta::Role;
 
 for my $modifier_type (qw/before after around/) {
@@ -40,6 +69,12 @@ sub get_method_modifier_list {
     return keys %{ $self->{$modifier_type . '_method_modifiers'} };
 }
 
+package Mouse::Meta::Method;
+
+sub get_original_method { Mouse::Meta::Method->wrap(sub { }) }
+
+sub associated_attribute { undef }
+
 package Mouse::Util::TypeConstraints;
 
 use Mouse::Util::TypeConstraints ();
@@ -57,10 +92,33 @@ sub export_type_constraints_as_functions { # TEST ONLY
     return;
 }
 
-package
-    Mouse::Meta::Attribute;
+package Mouse::Meta::Attribute;
 
 sub applied_traits{            $_[0]->{traits} } # TEST ONLY
 sub has_applied_traits{ exists $_[0]->{traits} } # TEST ONLY
 
+sub get_raw_value { undef } # not supported
+sub set_raw_value { undef } # not supported
+
+package Mouse::Meta::TypeConstraint;
+
+sub has_message { exists $_[0]->{message} }
+
+sub validate {
+    my($self, $value) = @_;
+    return $self->check($value) ? undef : $self->get_message($value);
+}
+
+sub is_subtype_of {
+    my($self, $other) = @_;
+    return undef; # not supported
+}
+
+sub equals {
+    my($self, $other) = @_;
+    return undef; # not supported
+}
+
+sub class { undef }
+sub role  { undef }
 1;