tweaking the attribute initializer stuff a little

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index b5ecac0..be88dc7 100644 (file)
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -339,8 +339,8 @@ Class::MOP::Attribute->meta->add_attribute(
 Class::MOP::Attribute->meta->add_attribute(
     Class::MOP::Attribute->new('$!initializer' => (
         init_arg  => 'initializer',
-        reader    => { 'initializer' => \&Class::MOP::Attribute::initializer },
-        predicate => { 'has_initializer'  => \&Class::MOP::Attribute::has_initializer },
+        reader    => { 'initializer'     => \&Class::MOP::Attribute::initializer     },
+        predicate => { 'has_initializer' => \&Class::MOP::Attribute::has_initializer },
     ))
 );
 

diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm
index 6bc203a..0cb31c8 100644 (file)
--- a/lib/Class/MOP/Attribute.pm
+++ b/lib/Class/MOP/Attribute.pm
@@ -56,22 +56,22 @@ sub new {
         '$!name'      => $name,
         '$!accessor'  => $options{accessor},
         '$!reader'    => $options{reader},
-        # NOTE:
-        # protect this from silliness
-        init_arg => '!............( DO NOT DO THIS )............!',
-        '$!writer'    => $options{writer},
-        '$!predicate' => $options{predicate},
-        '$!clearer'   => $options{clearer},
-        '$!builder'   => $options{builder},
-        '$!init_arg'  => $options{init_arg},
-        '$!default'   => $options{default},
+        '$!writer'      => $options{writer},
+        '$!predicate'   => $options{predicate},
+        '$!clearer'     => $options{clearer},
+        '$!builder'     => $options{builder},
+        '$!init_arg'    => $options{init_arg},
+        '$!default'     => $options{default},
+        '$!initializer' => $options{initializer},        
         # keep a weakened link to the
         # class we are associated with
         '$!associated_class' => undef,
-        '$!initializer'      => $options{initializer},
         # and a list of the methods
         # associated with this attr
         '@!associated_methods' => [],
+        # NOTE:
+        # protect this from silliness
+        init_arg => '!............( DO NOT DO THIS )............!',        
     } => $class;
 }
 
@@ -96,28 +96,25 @@ sub initialize_instance_slot {
     # if nothing was in the %params, we can use the
     # attribute's default value (if it has one)
     if(defined $init_arg and exists $params->{$init_arg}){
-        $meta_instance->_set_initial_slot_value(
+        $self->_set_initial_slot_value(
+            $meta_instance, 
             $instance,
-            $self->name,
             $params->{$init_arg},
-            $self->initializer,
         );
     } 
     elsif (defined $self->{'$!default'}) {
-        $meta_instance->_set_initial_slot_value(
+        $self->_set_initial_slot_value(
+            $meta_instance, 
             $instance,
-            $self->name,
             $self->default($instance),
-            $self->initializer,
         );
     } 
     elsif (defined( my $builder = $self->{'$!builder'})) {
         if ($builder = $instance->can($builder)) {
-            $meta_instance->_set_initial_slot_value(
+            $self->_set_initial_slot_value(
+                $meta_instance, 
                 $instance,
-                $self->name,
                 $instance->$builder,
-                $self->initializer,
             );
         } 
         else {
@@ -126,6 +123,24 @@ sub initialize_instance_slot {
     }
 }
 
+sub _set_initial_slot_value {
+    my ($self, $meta_instance, $instance, $value) = @_;
+
+    my $slot_name = $self->name;
+
+    return $meta_instance->set_slot_value($instance, $slot_name, $value)
+        unless $self->has_initializer;
+
+    my $callback = sub {
+        $meta_instance->set_slot_value($instance, $slot_name, $_[0]);
+    };
+    
+    my $initializer = $self->initializer;
+
+    # most things will just want to set a value, so make it first arg
+    $instance->$initializer($value, $callback, $self);
+}
+
 # NOTE:
 # the next bunch of methods will get bootstrapped
 # away in the Class::MOP bootstrapping section
@@ -135,23 +150,23 @@ sub name { $_[0]->{'$!name'} }
 sub associated_class   { $_[0]->{'$!associated_class'}   }
 sub associated_methods { $_[0]->{'@!associated_methods'} }
 
-sub has_accessor  { defined($_[0]->{'$!accessor'})  ? 1 : 0 }
-sub has_reader    { defined($_[0]->{'$!reader'})    ? 1 : 0 }
-sub has_writer    { defined($_[0]->{'$!writer'})    ? 1 : 0 }
-sub has_predicate { defined($_[0]->{'$!predicate'}) ? 1 : 0 }
-sub has_clearer   { defined($_[0]->{'$!clearer'})   ? 1 : 0 }
-sub has_builder   { defined($_[0]->{'$!builder'})   ? 1 : 0 }
-sub has_init_arg  { defined($_[0]->{'$!init_arg'})  ? 1 : 0 }
-sub has_default   { defined($_[0]->{'$!default'})   ? 1 : 0 }
+sub has_accessor    { defined($_[0]->{'$!accessor'})     ? 1 : 0 }
+sub has_reader      { defined($_[0]->{'$!reader'})       ? 1 : 0 }
+sub has_writer      { defined($_[0]->{'$!writer'})       ? 1 : 0 }
+sub has_predicate   { defined($_[0]->{'$!predicate'})    ? 1 : 0 }
+sub has_clearer     { defined($_[0]->{'$!clearer'})      ? 1 : 0 }
+sub has_builder     { defined($_[0]->{'$!builder'})      ? 1 : 0 }
+sub has_init_arg    { defined($_[0]->{'$!init_arg'})     ? 1 : 0 }
+sub has_default     { defined($_[0]->{'$!default'})      ? 1 : 0 }
 sub has_initializer { defined($_[0]->{'$!initializer'})  ? 1 : 0 }
 
-sub accessor  { $_[0]->{'$!accessor'}  }
-sub reader    { $_[0]->{'$!reader'}    }
-sub writer    { $_[0]->{'$!writer'}    }
-sub predicate { $_[0]->{'$!predicate'} }
-sub clearer   { $_[0]->{'$!clearer'}   }
-sub builder   { $_[0]->{'$!builder'}   }
-sub init_arg  { $_[0]->{'$!init_arg'}  }
+sub accessor    { $_[0]->{'$!accessor'}    }
+sub reader      { $_[0]->{'$!reader'}      }
+sub writer      { $_[0]->{'$!writer'}      }
+sub predicate   { $_[0]->{'$!predicate'}   }
+sub clearer     { $_[0]->{'$!clearer'}     }
+sub builder     { $_[0]->{'$!builder'}     }
+sub init_arg    { $_[0]->{'$!init_arg'}    }
 sub initializer { $_[0]->{'$!initializer'} }
 
 # end bootstrapped away method section.
@@ -242,10 +257,11 @@ sub associate_method {
 
 sub set_initial_value {
     my ($self, $instance, $value) = @_;
-
-    Class::MOP::Class->initialize(blessed($instance))
-                     ->get_meta_instance
-                     ->_set_initial_slot_value($instance, $self->name, $value, $self->initializer);
+    $self->set_initial_slot_value(
+        Class::MOP::Class->initialize(blessed($instance))->get_meta_instance,
+        $instance,
+        $value
+    );
 }
 
 sub set_value {

diff --git a/lib/Class/MOP/Instance.pm b/lib/Class/MOP/Instance.pm
index 8c0a73a..a9d5a5d 100644 (file)
--- a/lib/Class/MOP/Instance.pm
+++ b/lib/Class/MOP/Instance.pm
@@ -78,20 +78,6 @@ sub set_slot_value {
     $instance->{$slot_name} = $value;
 }
 
-sub _set_initial_slot_value {
-  my ($self, $instance, $slot_name, $value, $initializer) = @_;
-
-  return $self->set_slot_value($instance, $slot_name, $value)
-      unless $initializer;
-
-  my $callback = sub {
-    $self->set_slot_value($instance, $slot_name, $_[0]);
-  };
-
-  # most things will just want to set a value, so make it first arg
-  $instance->$initializer($value, $callback, $self);
-}
-
 sub initialize_slot {
     my ($self, $instance, $slot_name) = @_;
     #$self->set_slot_value($instance, $slot_name, undef);

diff --git a/t/014_attribute_introspection.t b/t/014_attribute_introspection.t
index 6fab683..8c8f878 100644 (file)
--- a/t/014_attribute_introspection.t
+++ b/t/014_attribute_introspection.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 60;
+use Test::More tests => 61;
 use Test::Exception;
 
 BEGIN {
@@ -24,6 +24,7 @@ BEGIN {
         new clone
 
         initialize_instance_slot
+        _set_initial_slot_value
 
         name
         has_accessor  accessor

diff --git a/t/024_attribute_initializer.t b/t/024_attribute_initializer.t
index db9aca5..c3cfc89 100644 (file)
--- a/t/024_attribute_initializer.t
+++ b/t/024_attribute_initializer.t
@@ -5,7 +5,7 @@ use warnings;
 
 use Scalar::Util 'blessed', 'reftype';
 
-use Test::More tests => 4;
+use Test::More tests => 10;
 
 BEGIN {
     use_ok('Class::MOP');
@@ -22,11 +22,15 @@ This checks that the initializer is used to set the initial value.
     use metaclass;
     
     Foo->meta->add_attribute('bar' => 
-        reader => 'get_bar',
-        writer => 'set_bar',
+        reader      => 'get_bar',
+        writer      => 'set_bar',
         initializer => sub {
-          my ($self, $value, $callback, $attr) = @_;
-          $callback->($value * 2);
+            my ($self, $value, $callback, $attr) = @_;
+            
+            ::isa_ok($attr, 'Class::MOP::Attribute');
+            ::is($attr->name, 'bar', '... the attribute is our own');
+            
+            $callback->($value * 2);
         },
     );  
 }
@@ -35,9 +39,25 @@ can_ok('Foo', 'get_bar');
 can_ok('Foo', 'set_bar');    
 
 my $foo = Foo->meta->construct_instance(bar => 10);
-is(
-  $foo->get_bar,
-  20,
-  "initial argument was doubled as expected",
-);
+is($foo->get_bar, 20, "... initial argument was doubled as expected");
+
+$foo->set_bar(30);
+
+is($foo->get_bar, 30, "... and setter works correctly");
+
+# meta tests ...
+
+my $bar = Foo->meta->get_attribute('bar');
+isa_ok($bar, 'Class::MOP::Attribute');
+
+ok($bar->has_initializer, '... bar has an initializer');
+is(reftype $bar->initializer, 'CODE', '... the initializer is a CODE ref');
+
+
+
+
+
+
+
+