From: Stevan Little Date: Wed, 4 Jun 2008 06:24:13 +0000 (+0000) Subject: some speed gains X-Git-Tag: 0_64~38 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9b522fc4b2f36a31ba00ddf00abf369c28c705c7;hp=352c364f8590198c4526a0cb36952325c7e7abc6;p=gitmo%2FClass-MOP.git some speed gains --- diff --git a/Changes b/Changes index 9f7fae7..7c56059 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,19 @@ Revision history for Perl extension Class-MOP. +0.59 + + * Class::MOP::Class + - now stores the instance of the instance + metaclass to avoid needless recomputation + + * Class::MOP + Class::MOP::Class + Class::MOP::Method + Class::MOP::Method::Wrapped + Class::MOP::Attribute + - switched usage of reftype to ref because + it is much faster + 0.58 Thurs. May 29, 2008 (late night release engineering)-- diff --git a/README b/README index 32af088..bdd7bca 100644 --- a/README +++ b/README @@ -1,4 +1,4 @@ -Class::MOP version 0.58 +Class::MOP version 0.59 =========================== See the individual module documentation for more information diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index 85a5a23..88cd78a 100644 --- a/lib/Class/MOP.pm +++ b/lib/Class/MOP.pm @@ -16,7 +16,7 @@ use Class::MOP::Method; use Class::MOP::Immutable; BEGIN { - our $VERSION = '0.58'; + our $VERSION = '0.59'; our $AUTHORITY = 'cpan:STEVAN'; *IS_RUNNING_ON_5_10 = ($] < 5.009_005) @@ -530,7 +530,7 @@ Class::MOP::Method->meta->add_method('wrap' => sub { my $code = shift; my %options = @_; - ('CODE' eq (Scalar::Util::reftype($code) || '')) + ('CODE' eq ref($code)) || confess "You must supply a CODE reference to bless, not (" . ($code || 'undef') . ")"; ($options{package_name} && $options{name}) diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm index 8d3fe04..9f09d2f 100644 --- a/lib/Class/MOP/Attribute.pm +++ b/lib/Class/MOP/Attribute.pm @@ -7,9 +7,9 @@ use warnings; use Class::MOP::Method::Accessor; use Carp 'confess'; -use Scalar::Util 'blessed', 'reftype', 'weaken'; +use Scalar::Util 'blessed', 'weaken'; -our $VERSION = '0.25'; +our $VERSION = '0.26'; our $AUTHORITY = 'cpan:STEVAN'; use base 'Class::MOP::Object'; @@ -231,7 +231,7 @@ sub get_write_method_ref { } sub is_default_a_coderef { - ('CODE' eq (reftype($_[0]->{'$!default'} || $_[0]->{default}) || '')) + ('CODE' eq ref($_[0]->{'$!default'} || $_[0]->{default})) } sub default { @@ -320,8 +320,8 @@ sub accessor_metaclass { 'Class::MOP::Method::Accessor' } sub process_accessors { my ($self, $type, $accessor, $generate_as_inline_methods) = @_; - if (reftype($accessor)) { - (reftype($accessor) eq 'HASH') + if (ref($accessor)) { + (ref($accessor) eq 'HASH') || confess "bad accessor/reader/writer/predicate/clearer format, must be a HASH ref"; my ($name, $method) = %{$accessor}; $method = $self->accessor_metaclass->wrap( @@ -381,7 +381,7 @@ sub install_accessors { { my $_remove_accessor = sub { my ($accessor, $class) = @_; - if (reftype($accessor) && reftype($accessor) eq 'HASH') { + if (ref($accessor) && ref($accessor) eq 'HASH') { ($accessor) = keys %{$accessor}; } my $method = $class->get_method($accessor); diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index 642accb..a3ac27d 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -9,9 +9,9 @@ use Class::MOP::Instance; use Class::MOP::Method::Wrapped; use Carp 'confess'; -use Scalar::Util 'blessed', 'reftype', 'weaken'; +use Scalar::Util 'blessed', 'weaken'; -our $VERSION = '0.32'; +our $VERSION = '0.33'; our $AUTHORITY = 'cpan:STEVAN'; use base 'Class::MOP::Module'; @@ -103,7 +103,8 @@ sub construct_class_instance { # we can tell the first time the # methods are fetched # - SL - '$!_package_cache_flag' => undef, + '$!_package_cache_flag' => undef, + '$!_meta_instance' => undef, } => $class; } else { @@ -367,7 +368,7 @@ sub construct_instance { # NOTE: # this will only work for a HASH instance type if ($class->is_anon_class) { - (reftype($instance) eq 'HASH') + (Scalar::Util::reftype($instance) eq 'HASH') || confess "Currently only HASH based instances are supported with instance of anon-classes"; # NOTE: # At some point we should make this official @@ -379,11 +380,26 @@ sub construct_instance { return $instance; } + sub get_meta_instance { - my $class = shift; - return $class->instance_metaclass->new( - $class, - $class->compute_all_applicable_attributes() + my $self = shift; + # NOTE: + # just about any fiddling with @ISA or + # any fiddling with attributes will + # also fiddle with the symbol table + # and therefore invalidate the package + # cache, in which case we should blow + # away the meta-instance cache. Of course + # this will invalidate it more often then + # is probably needed, but better safe + # then sorry. + # - SL + $self->{'$!_meta_instance'} = undef + if defined $self->{'$!_package_cache_flag'} && + $self->{'$!_package_cache_flag'} == Class::MOP::check_package_cache_flag($self->name); + $self->{'$!_meta_instance'} ||= $self->instance_metaclass->new( + $self, + $self->compute_all_applicable_attributes() ); } @@ -580,7 +596,7 @@ sub add_method { } else { $body = $method; - ('CODE' eq (reftype($body) || '')) + ('CODE' eq ref($body)) || confess "Your code block must be a CODE reference"; $method = $self->method_metaclass->wrap( $body => ( @@ -674,7 +690,7 @@ sub alias_method { || confess "You must define a method name"; my $body = (blessed($method) ? $method->body : $method); - ('CODE' eq (reftype($body) || '')) + ('CODE' eq ref($body)) || confess "Your code block must be a CODE reference"; $self->add_package_symbol("&${method_name}" => $body); diff --git a/lib/Class/MOP/Method.pm b/lib/Class/MOP/Method.pm index 0c8fd12..1553ff6 100644 --- a/lib/Class/MOP/Method.pm +++ b/lib/Class/MOP/Method.pm @@ -5,9 +5,9 @@ use strict; use warnings; use Carp 'confess'; -use Scalar::Util 'reftype', 'blessed'; +use Scalar::Util 'blessed'; -our $VERSION = '0.08'; +our $VERSION = '0.09'; our $AUTHORITY = 'cpan:STEVAN'; use base 'Class::MOP::Object'; @@ -31,7 +31,7 @@ before spending too much time chasing this one down. sub wrap { my ( $class, $code, %params ) = @_; - ('CODE' eq (reftype($code) || '')) + ('CODE' eq ref($code)) || confess "You must supply a CODE reference to bless, not (" . ($code || 'undef') . ")"; ($params{package_name} && $params{name}) diff --git a/lib/Class/MOP/Method/Wrapped.pm b/lib/Class/MOP/Method/Wrapped.pm index fb3cd6d..0f0a969 100644 --- a/lib/Class/MOP/Method/Wrapped.pm +++ b/lib/Class/MOP/Method/Wrapped.pm @@ -5,9 +5,9 @@ use strict; use warnings; use Carp 'confess'; -use Scalar::Util 'reftype', 'blessed'; +use Scalar::Util 'blessed'; -our $VERSION = '0.03'; +our $VERSION = '0.04'; our $AUTHORITY = 'cpan:STEVAN'; use base 'Class::MOP::Method'; diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t index e440c99..a933e85 100644 --- a/t/010_self_introspection.t +++ b/t/010_self_introspection.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 201; +use Test::More tests => 200; use Test::Exception; BEGIN { @@ -125,7 +125,7 @@ foreach my $method_name (@class_mop_module_methods) { foreach my $non_method_name (qw( confess - blessed reftype + blessed subname svref_2object )) {