Update t/lib/MooseCompat.pm
Fuji, Goro [Sat, 25 Sep 2010 02:30:09 +0000 (11:30 +0900)]
t/lib/MooseCompat.pm

index 19ae7cb..8bb95cf 100644 (file)
@@ -1,5 +1,33 @@
 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__;
+
+
+*UNIVERSAL::DOES = sub {
+    my($thing, $role) = @_;
+    $thing->isa($role);
+} unless UNIVERSAL->can('DOES');
+
+$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 +42,8 @@ sub identifier {
     );
 }
 
+sub role_applications { }
+
 package Mouse::Meta::Role;
 
 for my $modifier_type (qw/before after around/) {
@@ -40,6 +70,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 +93,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;