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 (executable)
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 (executable)
--- 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 (executable)
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 (executable)
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 (file)
--- 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 (file)
--- 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<Class::MOP::Attribute>
-object, I<or> or as a hash reference of options which will be passed
-to the attribute metaclass's constructor.
+An optional array reference of L<Class::MOP::Attribute> objects.
 
 =back
 

diff --git a/lib/Class/MOP/Method/Constructor.pm b/lib/Class/MOP/Method/Constructor.pm
index 38b31d5..9a1bf3f 100644 (file)
--- 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',