[Moose-commits] r7666 - in Class-MOP/trunk: lib/Class lib/Class/MOP
t
rafl at code2.0beta.co.uk
rafl at code2.0beta.co.uk
Sat Feb 14 00:44:55 GMT 2009
Author: rafl
Date: 2009-02-13 16:44:55 -0800 (Fri, 13 Feb 2009)
New Revision: 7666
Modified:
Class-MOP/trunk/lib/Class/MOP.pm
Class-MOP/trunk/lib/Class/MOP/Class.pm
Class-MOP/trunk/t/010_self_introspection.t
Log:
Add a wrapped_method_metaclass attribute to CMOP::Class.
Stop hardcoding Class::MOP::Method::Wrapped.
Modified: Class-MOP/trunk/lib/Class/MOP/Class.pm
===================================================================
--- Class-MOP/trunk/lib/Class/MOP/Class.pm 2009-02-13 21:13:07 UTC (rev 7665)
+++ Class-MOP/trunk/lib/Class/MOP/Class.pm 2009-02-14 00:44:55 UTC (rev 7666)
@@ -103,7 +103,7 @@
bless {
# inherited from Class::MOP::Package
- 'package' => $options->{package},
+ 'package' => $options->{package},
# NOTE:
# since the following attributes will
@@ -113,18 +113,19 @@
# listed here for reference, because they
# should not actually have a value associated
# with the slot.
- 'namespace' => \undef,
+ 'namespace' => \undef,
# inherited from Class::MOP::Module
- 'version' => \undef,
- 'authority' => \undef,
+ 'version' => \undef,
+ 'authority' => \undef,
# defined in Class::MOP::Class
- 'superclasses' => \undef,
+ 'superclasses' => \undef,
- 'methods' => {},
- 'attributes' => {},
- 'attribute_metaclass' => $options->{'attribute_metaclass'} || 'Class::MOP::Attribute',
- 'method_metaclass' => $options->{'method_metaclass'} || 'Class::MOP::Method',
- 'instance_metaclass' => $options->{'instance_metaclass'} || 'Class::MOP::Instance',
+ 'methods' => {},
+ 'attributes' => {},
+ 'attribute_metaclass' => $options->{'attribute_metaclass'} || 'Class::MOP::Attribute',
+ 'method_metaclass' => $options->{'method_metaclass'} || 'Class::MOP::Method',
+ 'wrapped_method_metaclass' => $options->{'wrapped_method_metaclass'} || 'Class::MOP::Method::Wrapped',
+ 'instance_metaclass' => $options->{'instance_metaclass'} || 'Class::MOP::Instance',
}, $class;
}
@@ -306,10 +307,11 @@
# all these attribute readers will be bootstrapped
# away in the Class::MOP bootstrap section
-sub get_attribute_map { $_[0]->{'attributes'} }
-sub attribute_metaclass { $_[0]->{'attribute_metaclass'} }
-sub method_metaclass { $_[0]->{'method_metaclass'} }
-sub instance_metaclass { $_[0]->{'instance_metaclass'} }
+sub get_attribute_map { $_[0]->{'attributes'} }
+sub attribute_metaclass { $_[0]->{'attribute_metaclass'} }
+sub method_metaclass { $_[0]->{'method_metaclass'} }
+sub wrapped_method_metaclass { $_[0]->{'wrapped_method_metaclass'} }
+sub instance_metaclass { $_[0]->{'instance_metaclass'} }
sub get_method_map {
my $self = shift;
@@ -658,6 +660,7 @@
{
my $fetch_and_prepare_method = sub {
my ($self, $method_name) = @_;
+ my $wrapped_metaclass = $self->wrapped_method_metaclass;
# fetch it locally
my $method = $self->get_method($method_name);
# if we dont have local ...
@@ -670,12 +673,12 @@
# and now make sure to wrap it
# even if it is already wrapped
# because we need a new sub ref
- $method = Class::MOP::Method::Wrapped->wrap($method);
+ $method = $wrapped_metaclass->wrap($method);
}
else {
# now make sure we wrap it properly
- $method = Class::MOP::Method::Wrapped->wrap($method)
- unless $method->isa('Class::MOP::Method::Wrapped');
+ $method = $wrapped_metaclass->wrap($method)
+ unless $method->isa($wrapped_metaclass);
}
$self->add_method($method_name => $method);
return $method;
Modified: Class-MOP/trunk/lib/Class/MOP.pm
===================================================================
--- Class-MOP/trunk/lib/Class/MOP.pm 2009-02-13 21:13:07 UTC (rev 7665)
+++ Class-MOP/trunk/lib/Class/MOP.pm 2009-02-14 00:44:55 UTC (rev 7666)
@@ -388,6 +388,18 @@
);
Class::MOP::Class->meta->add_attribute(
+ Class::MOP::Attribute->new('wrapped_method_metaclass' => (
+ reader => {
+ # NOTE:
+ # we just alias the original method
+ # rather than re-produce it here
+ 'wrapped_method_metaclass' => \&Class::MOP::Class::wrapped_method_metaclass
+ },
+ default => 'Class::MOP::Method::Wrapped',
+ ))
+);
+
+Class::MOP::Class->meta->add_attribute(
Class::MOP::Attribute->new('instance_metaclass' => (
reader => {
# NOTE: we need to do this in order
Modified: Class-MOP/trunk/t/010_self_introspection.t
===================================================================
--- Class-MOP/trunk/t/010_self_introspection.t 2009-02-13 21:13:07 UTC (rev 7665)
+++ Class-MOP/trunk/t/010_self_introspection.t 2009-02-14 00:44:55 UTC (rev 7666)
@@ -1,7 +1,7 @@
use strict;
use warnings;
-use Test::More tests => 236;
+use Test::More tests => 246;
use Test::Exception;
use Class::MOP;
@@ -66,7 +66,7 @@
add_dependent_meta_instance remove_dependent_meta_instance
invalidate_meta_instances invalidate_meta_instance
- attribute_metaclass method_metaclass
+ attribute_metaclass method_metaclass wrapped_method_metaclass
superclasses subclasses class_precedence_list linearized_isa
@@ -157,6 +157,7 @@
'attributes',
'attribute_metaclass',
'method_metaclass',
+ 'wrapped_method_metaclass',
'instance_metaclass'
);
@@ -269,6 +270,21 @@
'Class::MOP::Method',
'... Class::MOP::Class method_metaclass\'s a default is Class::MOP:::Method');
+ok($class_mop_class_meta->get_attribute('wrapped_method_metaclass')->has_reader, '... Class::MOP::Class wrapped_method_metaclass has a reader');
+is_deeply($class_mop_class_meta->get_attribute('wrapped_method_metaclass')->reader,
+ { 'wrapped_method_metaclass' => \&Class::MOP::Class::wrapped_method_metaclass },
+ '... Class::MOP::Class wrapped_method_metaclass\'s a reader is &wrapped_method_metaclass');
+
+ok($class_mop_class_meta->get_attribute('wrapped_method_metaclass')->has_init_arg, '... Class::MOP::Class wrapped_method_metaclass has a init_arg');
+is($class_mop_class_meta->get_attribute('wrapped_method_metaclass')->init_arg,
+ 'wrapped_method_metaclass',
+ '... Class::MOP::Class wrapped_method_metaclass\'s init_arg is wrapped_method_metaclass');
+
+ok($class_mop_class_meta->get_attribute('method_metaclass')->has_default, '... Class::MOP::Class method_metaclass has a default');
+is($class_mop_class_meta->get_attribute('method_metaclass')->default,
+ 'Class::MOP::Method',
+ '... Class::MOP::Class method_metaclass\'s a default is Class::MOP:::Method');
+
# check the values of some of the methods
is($class_mop_class_meta->name, 'Class::MOP::Class', '... Class::MOP::Class->name');
More information about the Moose-commits
mailing list