From: Shawn M Moore Date: Wed, 15 Jul 2009 07:21:06 +0000 (-0400) Subject: Merge branch 'topic/no-get_method_map' of git://github.com/gfx/class-mop X-Git-Tag: 0.90~19 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9ec520256a955cf40209cc0c55ed4afe5914c15c;hp=70df4709bf61592d5dfdcaa53b2a80b18f6bc9c3;p=gitmo%2FClass-MOP.git Merge branch 'topic/no-get_method_map' of git://github.com/gfx/class-mop --- diff --git a/bench/foo.pl b/bench/foo.pl new file mode 100755 index 0000000..a2c799a --- /dev/null +++ b/bench/foo.pl @@ -0,0 +1,66 @@ +#!perl +# a moose using script for profiling +# Usage: perl bench/profile.pl + +package Foo; +use Moose; + +has aaa => ( + is => 'rw', + isa => 'Str', +); + +has bbb => ( + is => 'rw', + isa => 'Str', +); + +has ccc => ( + is => 'rw', + isa => 'Str', +); + +has ddd => ( + is => 'rw', + isa => 'Str', +); + +has eee => ( + is => 'rw', + isa => 'Str', +); + +__PACKAGE__->meta->make_immutable(); + + +package Bar; +use Moose; + +extends 'Foo'; + +has xaaa => ( + is => 'rw', + isa => 'Str', +); + +has xbbb => ( + is => 'rw', + isa => 'Str', +); + +has xccc => ( + is => 'rw', + isa => 'Str', +); + +has xddd => ( + is => 'rw', + isa => 'Str', +); + +has xeee => ( + is => 'rw', + isa => 'Str', +); + +__PACKAGE__->meta->make_immutable(); diff --git a/bench/loading-benchmark.pl b/bench/loading-benchmark.pl index 0800739..2994f6c 100755 --- a/bench/loading-benchmark.pl +++ b/bench/loading-benchmark.pl @@ -2,9 +2,11 @@ use strict; use Benchmark qw(:all); -my $module = 'Moose'; +my($count, $module) = @ARGV; +$count ||= 10; +$module ||= 'Moose'; -cmpthese timethese 10 => { +cmpthese timethese $count => { released => sub { system( $^X, '-e', "require $module" ) == 0 or die; }, diff --git a/bench/loading-profile.pl b/bench/loading-profile.pl deleted file mode 100755 index 5337d84..0000000 --- a/bench/loading-profile.pl +++ /dev/null @@ -1,2 +0,0 @@ -#!perl -wd:NYTProf -require Moose; diff --git a/bench/profile.pl b/bench/profile.pl new file mode 100755 index 0000000..c4ffc6f --- /dev/null +++ b/bench/profile.pl @@ -0,0 +1,25 @@ +#!perl -w +# Usage: perl bench/profile.pl (no other options including -Mblib are reqired) + +use strict; + +my $script = 'bench/foo.pl'; + +my $branch = do{ + open my $in, '.git/HEAD' or die "Cannot open .git/HEAD: $!"; + my $s = scalar <$in>; + chomp $s; + $s =~ s{^ref: \s+ refs/heads/}{}xms; + $s =~ s{/}{_}xmsg; + $s; +}; + +print "Profiling $branch ...\n"; + +my @cmd = ($^X, '-Iblib/lib', '-Iblib/arch', $script); +print "> @cmd\n"; +system(@cmd) == 0 or die "Cannot profile"; + +@cmd = ($^X, '-S', 'nytprofhtml', '--out', "nytprof-$branch"); +print "> @cmd\n"; +system(@cmd) == 0 or die "Cannot profile"; diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index e3c38ff..2b118d8 100644 --- a/lib/Class/MOP.pm +++ b/lib/Class/MOP.pm @@ -92,10 +92,10 @@ sub load_first_existing_class { my $found; my %exceptions; for my $class (@classes) { - my $pmfile = _class_to_pmfile($class); my $e = _try_load_one_class($class); if ($e) { + my $pmfile = _class_to_pmfile($class); $exceptions{$class} = $e; last if $e !~ /^Can't locate \Q$pmfile\E in \@INC/; } diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index d61c758..e3a143b 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -874,23 +874,25 @@ sub add_attribute { # about the class which it is attached to $attribute->attach_to_class($self); + my $attr_name = $attribute->name; + # then we remove attributes of a conflicting # name here so that we can properly detach # the old attr object, and remove any # accessors it would have generated - if ( $self->has_attribute($attribute->name) ) { - $self->remove_attribute($attribute->name); + if ( $self->has_attribute($attr_name) ) { + $self->remove_attribute($attr_name); } else { $self->invalidate_meta_instances(); } # get our count of previously inserted attributes and # increment by one so this attribute knows its order - my $order = (scalar keys %{$self->get_attribute_map}) - 1; - $attribute->_set_insertion_order($order + 1); + my $order = (scalar keys %{$self->get_attribute_map}); + $attribute->_set_insertion_order($order); # then onto installing the new accessors - $self->get_attribute_map->{$attribute->name} = $attribute; + $self->get_attribute_map->{$attr_name} = $attribute; # invalidate package flag here my $e = do { @@ -900,7 +902,7 @@ sub add_attribute { $@; }; if ( $e ) { - $self->remove_attribute($attribute->name); + $self->remove_attribute($attr_name); die $e; } @@ -1372,11 +1374,7 @@ hash reference are method names, and values are subroutine references. =item * attributes -An optional array reference of attributes. - -An attribute can be passed as an existing L -object, I or as a hash reference of options which will be passed -to the attribute metaclass's constructor. +An optional array reference of L objects. =back diff --git a/lib/Class/MOP/Method/Constructor.pm b/lib/Class/MOP/Method/Constructor.pm index 38b31d5..9a1bf3f 100644 --- a/lib/Class/MOP/Method/Constructor.pm +++ b/lib/Class/MOP/Method/Constructor.pm @@ -174,13 +174,13 @@ sub _generate_slot_initializer { $default = '$instance->'.$attr->builder; } - if ( defined $attr->init_arg ) { + if ( defined(my $init_arg = $attr->init_arg) ) { return ( - 'if(exists $params->{\'' . $attr->init_arg . '\'}){' . "\n" . + 'if(exists $params->{\'' . $init_arg . '\'}){' . "\n" . $self->_meta_instance->inline_set_slot_value( '$instance', $attr->name, - '$params->{\'' . $attr->init_arg . '\'}' ) . "\n" . + '$params->{\'' . $init_arg . '\'}' ) . "\n" . '} ' . (!defined $default ? '' : 'else {' . "\n" . $self->_meta_instance->inline_set_slot_value( '$instance',