From: Fuji, Goro <gfuji@cpan.org>
Date: Sat, 25 Sep 2010 09:35:55 +0000 (+0900)
Subject: Remove the no-inline version of attribute initialization code
X-Git-Tag: 0.72~7
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a3a09e3898ca09a1dd734439a59d60b18575758c;p=gitmo%2FMouse.git

Remove the no-inline version of attribute initialization code
---

diff --git a/lib/Mouse/Meta/Class.pm b/lib/Mouse/Meta/Class.pm
index 2ab14cb..decbfb1 100644
--- a/lib/Mouse/Meta/Class.pm
+++ b/lib/Mouse/Meta/Class.pm
@@ -238,6 +238,9 @@ sub add_attribute {
         Carp::carp(qq{Attribute ($name) of class }.$self->name
             .qq{ has no associated methods (did you mean to provide an "is" argument?)});
     }
+    if(!Mouse::Util::MOUSE_XS) {
+        delete $self->{_initialize_object};
+    }
     return $attr;
 }
 
diff --git a/lib/Mouse/Meta/Method/Constructor.pm b/lib/Mouse/Meta/Method/Constructor.pm
index ee75260..c45fd9c 100644
--- a/lib/Mouse/Meta/Method/Constructor.pm
+++ b/lib/Mouse/Meta/Method/Constructor.pm
@@ -11,43 +11,43 @@ sub _generate_constructor {
 
     my $associated_metaclass_name = $metaclass->name;
 
-    my @attrs         = $metaclass->get_all_attributes;
-
     my $buildall      = $class->_generate_BUILDALL($metaclass);
     my $buildargs     = $class->_generate_BUILDARGS($metaclass);
-    my $processattrs  = $class->_generate_processattrs($metaclass, \@attrs);
-
-    my @checks = map { $_ && $_->_compiled_type_constraint }
-                 map { $_->type_constraint } @attrs;
 
-    my $source = sprintf("#line %d %s\n", __LINE__, __FILE__).<<"...";
-        sub \{
-            my \$class = shift;
-            return \$class->Mouse::Object::new(\@_)
-                if \$class ne q{$associated_metaclass_name};
+    my $source = sprintf(<<'EOT', __LINE__, __FILE__, $metaclass->name, $buildargs, $buildall);
+#line %d %s
+        package %s;
+        sub {
+            my $class = shift;
+            return $class->Mouse::Object::new(@_)
+                if $class ne __PACKAGE__;
             # BUILDARGS
-            $buildargs;
-            my \$instance = bless {}, \$class;
-            # process attributes
-            $processattrs;
+            %s;
+            my $instance = bless {}, $class;
+            $metaclass->_initialize_object($instance, $args, 0);
             # BUILDALL
-            $buildall;
-            return \$instance;
+            %s;
+            return $instance;
         }
-...
+EOT
     #warn $source;
-    my $code;
+    my $body;
     my $e = do{
         local $@;
-        $code = eval $source;
+        $body = eval $source;
         $@;
     };
     die $e if $e;
-    return $code;
+    return $body;
 }
 
-sub _generate_processattrs {
-    my ($method_class, $metaclass, $attrs) = @_;
+sub _generate_initialize_object {
+    my ($method_class, $metaclass) = @_;
+    my @attrs  = $metaclass->get_all_attributes;
+
+    my @checks = map { $_ && $_->_compiled_type_constraint }
+                 map { $_->type_constraint } @attrs;
+
     my @res;
 
     my $has_triggers;
@@ -57,10 +57,10 @@ sub _generate_processattrs {
         push @res, 'my $used = 0;';
     }
 
-    for my $index (0 .. @$attrs - 1) {
+    for my $index (0 .. @attrs - 1) {
         my $code = '';
 
-        my $attr = $attrs->[$index];
+        my $attr = $attrs[$index];
         my $key  = $attr->name;
 
         my $init_arg        = $attr->init_arg;
@@ -81,13 +81,15 @@ sub _generate_processattrs {
 
         my $post_process = '';
         if(defined $type_constraint){
-            $post_process .= "\$checks[$index]->($instance_slot)";
+            $post_process .= "\$checks[$index]->($instance_slot)\n";
             $post_process .= "  or $attr_var->_throw_type_constraint_error($instance_slot, $constraint_var);\n";
         }
         if($is_weak_ref){
-            $post_process .= "Scalar::Util::weaken($instance_slot) if ref $instance_slot;\n";
+            $post_process  = "Scalar::Util::weaken($instance_slot) "
+                             . "if ref $instance_slot;\n";
         }
 
+        # build cde for an attribute
         if (defined $init_arg) {
             my $value = "\$args->{q{$init_arg}}";
 
@@ -136,13 +138,12 @@ sub _generate_processattrs {
                 }
 
                 $code .= "$instance_slot = $value;\n";
-                if($is_weak_ref){
-                    $code .= "Scalar::Util::weaken($instance_slot);\n";
-                }
+                $code .= $post_process;
             }
         }
         elsif ($attr->is_required) {
-            $code .= "Carp::confess('Attribute ($key) is required');";
+            $code .= "\$meta->throw_error('Attribute ($key) is required')";
+            $code .= "    unless \$is_cloning;\n";
         }
 
         $code .= "}\n" if defined $init_arg;
@@ -152,11 +153,11 @@ sub _generate_processattrs {
 
     if($strict){
         push @res, q{if($used < keys %{$args})}
-            . q{{ $metaclass->_report_unknown_args(\@attrs, $args) }};
+            . q{{ $meta->_report_unknown_args(\@attrs, $args) }};
     }
 
     if($metaclass->is_anon_class){
-        push @res, q{$instance->{__METACLASS__} = $metaclass;};
+        push @res, q{$instance->{__METACLASS__} = $meta;};
     }
 
     if($has_triggers){
@@ -164,7 +165,24 @@ sub _generate_processattrs {
         push    @res, q{$_->[0]->($instance, $_->[1]) for @triggers;};
     }
 
-    return join "\n", @res;
+    my $source = sprintf <<'EOT', __LINE__, __FILE__, $metaclass->name, join "\n", @res;
+#line %d %s
+    package %s;
+    sub {
+        my($meta, $instance, $args, $is_cloning) = @_;
+        %s;
+        return $instance;
+    }
+EOT
+    warn $source if $ENV{MOUSE_DEBUG};
+    my $body;
+    my $e = do {
+        local $@;
+        $body = eval $source;
+        $@;
+    };
+    die $e if $e;
+    return $body;
 }
 
 sub _generate_BUILDARGS {
diff --git a/lib/Mouse/PurePerl.pm b/lib/Mouse/PurePerl.pm
index fb1909f..fefcbcc 100644
--- a/lib/Mouse/PurePerl.pm
+++ b/lib/Mouse/PurePerl.pm
@@ -294,7 +294,7 @@ sub new_object {
 
     my $object = bless {}, $meta->name;
 
-    $meta->_initialize_object($object, \%args);
+    $meta->_initialize_object($object, \%args, 0);
     # BUILDALL
     if( $object->can('BUILD') ) {
         for my $class (reverse $meta->linearized_isa) {
@@ -323,63 +323,11 @@ sub clone_object {
 
 sub _initialize_object{
     my($self, $object, $args, $is_cloning) = @_;
-
-    my @triggers_queue;
-
-    my $used = 0;
-
-    foreach my $attribute ($self->get_all_attributes) {
-        my $init_arg = $attribute->init_arg;
-        my $slot     = $attribute->name;
-
-        if (defined($init_arg) && exists($args->{$init_arg})) {
-            $object->{$slot} = $attribute->_coerce_and_verify($args->{$init_arg}, $object);
-
-            weaken($object->{$slot})
-                if ref($object->{$slot}) && $attribute->is_weak_ref;
-
-            if ($attribute->has_trigger) {
-                push @triggers_queue, [ $attribute->trigger, $object->{$slot} ];
-            }
-            $used++;
-        }
-        else { # no init arg
-            if ($attribute->has_default || $attribute->has_builder) {
-                if (!$attribute->is_lazy && !exists $object->{$slot}) {
-                    my $default = $attribute->default;
-                    my $builder = $attribute->builder;
-                    my $value =   $builder                ? $object->$builder()
-                                : ref($default) eq 'CODE' ? $object->$default()
-                                :                           $default;
-
-                    $object->{$slot} = $attribute->_coerce_and_verify($value, $object);
-
-                    weaken($object->{$slot})
-                        if ref($object->{$slot}) && $attribute->is_weak_ref;
-                }
-            }
-            elsif(!$is_cloning && $attribute->is_required) {
-                $self->throw_error("Attribute (".$attribute->name.") is required");
-            }
-        }
-    }
-
-    if($used < keys %{$args} && $self->strict_constructor) {
-        $self->_report_unknown_args([ $self->get_all_attributes ], $args);
-    }
-
-    if(@triggers_queue){
-        foreach my $trigger_and_value(@triggers_queue){
-            my($trigger, $value) = @{$trigger_and_value};
-            $trigger->($object, $value);
-        }
-    }
-
-    if($self->is_anon_class){
-        $object->{__METACLASS__} = $self;
-    }
-
-    return;
+    my $initializer = $self->{_initialize_object} ||= do {
+        Mouse::Util::load_class($self->constructor_class)
+            ->_generate_initialize_object($self);
+    };
+    goto &{$initializer};
 }
 
 sub is_immutable {  $_[0]->{is_immutable} }
@@ -738,9 +686,8 @@ sub DESTROY {
 
     return unless $self->can('DEMOLISH'); # short circuit
 
-    local $?;
-
     my $e = do{
+        local $?;
         local $@;
         eval{
             # DEMOLISHALL