working-on-it

diff --git a/examples/ArrayBasedStorage.pod b/examples/ArrayBasedStorage.pod
index 8268d4c..aa174db 100644 (file)
--- a/examples/ArrayBasedStorage.pod
+++ b/examples/ArrayBasedStorage.pod
@@ -1,5 +1,76 @@
 
 package # hide the package from PAUSE
+    ArrayBasedStorage::Attribute;
+    
+use strict;
+use warnings;
+
+use Carp 'confess';
+
+our $VERSION = '0.01';
+
+use base 'Class::MOP::Attribute';
+
+sub initialize_instance_slot {
+    my ($self, $meta_instance, $instance, $params) = @_;
+    my $init_arg = $self->{init_arg};
+    # try to fetch the init arg from the %params ...
+    my $val;        
+    $val = $params->{$init_arg} if exists $params->{$init_arg};
+    # if nothing was in the %params, we can use the 
+    # attribute's default value (if it has one)
+    if (!defined $val && defined $self->{default}) {
+        $val = $self->default($instance);
+    }
+    $meta_instance->set_slot_value($instance, $self->name, $val);
+}
+
+sub generate_accessor_method {
+    my $self = shift;
+    my $meta_class = $self->associated_class;    
+    my $attr_name  = $self->name;
+    return sub {
+        my $meta_instance = $meta_class->initialize(Scalar::Util::blessed($_[0]))->get_meta_instance;
+        $meta_instance->set_slot_value($_[0], $attr_name, $_[1]) if scalar(@_) == 2;
+        $meta_instance->get_slot_value($_[0], $attr_name);
+    };
+}
+
+sub generate_reader_method {
+    my $self = shift;
+    my $meta_class = $self->associated_class;    
+    my $attr_name  = $self->name;
+    return sub { 
+        confess "Cannot assign a value to a read-only accessor" if @_ > 1;
+        $meta_class->initialize(Scalar::Util::blessed($_[0]))
+                   ->get_meta_instance
+                   ->get_slot_value($_[0], $attr_name); 
+    };   
+}
+
+sub generate_writer_method {
+    my $self = shift;
+    my $meta_class = $self->associated_class;    
+    my $attr_name  = $self->name;
+    return sub { 
+        $meta_class->initialize(Scalar::Util::blessed($_[0]))
+                   ->get_meta_instance
+                   ->set_slot_value($_[0], $attr_name, $_[1]);
+    };
+}
+
+sub generate_predicate_method {
+    my $self = shift;
+    my $meta_class = $self->associated_class;    
+    my $attr_name  = $self->name;
+    return sub { 
+        defined $meta_class->initialize(Scalar::Util::blessed($_[0]))
+                           ->get_meta_instance
+                           ->get_slot_value($_[0], $attr_name) ? 1 : 0;
+    };
+}    
+
+package # hide the package from PAUSE
     ArrayBasedStorage::Instance;
 
 use strict;
@@ -26,6 +97,8 @@ sub create_instance {
 
 # operations on meta instance
 
+sub get_slot_index_map { (shift)->{slot_index_map} }
+
 sub get_all_slots {
     my $self = shift;
     return sort @{$self->{slots}};

diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm
index cf12216..b85a8a2 100644 (file)
--- a/lib/Class/MOP/Attribute.pm
+++ b/lib/Class/MOP/Attribute.pm
@@ -71,7 +71,9 @@ sub initialize_instance_slot {
     if (!defined $val && defined $self->{default}) {
         $val = $self->default($instance);
     }
-    $meta_instance->set_slot_value($instance, $self->name, $val);
+    $self->associated_class
+         ->get_meta_instance
+         ->set_slot_value($instance, $self->name, $val);
 }
 
 # NOTE:
@@ -135,7 +137,7 @@ sub generate_accessor_method {
     my $meta_class = $self->associated_class;    
     my $attr_name  = $self->name;
     return sub {
-        my $meta_instance = $meta_class->initialize(Scalar::Util::blessed($_[0]))->get_meta_instance;
+        my $meta_instance = $meta_class->get_meta_instance;
         $meta_instance->set_slot_value($_[0], $attr_name, $_[1]) if scalar(@_) == 2;
         $meta_instance->get_slot_value($_[0], $attr_name);
     };
@@ -147,8 +149,7 @@ sub generate_reader_method {
     my $attr_name  = $self->name;
     return sub { 
         confess "Cannot assign a value to a read-only accessor" if @_ > 1;
-        $meta_class->initialize(Scalar::Util::blessed($_[0]))
-                   ->get_meta_instance
+        $meta_class->get_meta_instance
                    ->get_slot_value($_[0], $attr_name); 
     };   
 }
@@ -158,8 +159,7 @@ sub generate_writer_method {
     my $meta_class = $self->associated_class;    
     my $attr_name  = $self->name;
     return sub { 
-        $meta_class->initialize(Scalar::Util::blessed($_[0]))
-                   ->get_meta_instance
+        $meta_class->get_meta_instance
                    ->set_slot_value($_[0], $attr_name, $_[1]);
     };
 }
@@ -169,8 +169,7 @@ sub generate_predicate_method {
     my $meta_class = $self->associated_class;    
     my $attr_name  = $self->name;
     return sub { 
-        defined $meta_class->initialize(Scalar::Util::blessed($_[0]))
-                           ->get_meta_instance
+        defined $meta_class->get_meta_instance
                            ->get_slot_value($_[0], $attr_name) ? 1 : 0;
     };
 }

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index a95d0b8..62877fb 100644 (file)
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -181,7 +181,6 @@ sub construct_instance {
     my ($class, %params) = @_;
     my $meta_instance = $class->get_meta_instance();
     my $instance = $meta_instance->create_instance();
-    $meta_instance->initialize_all_slots($instance);
     foreach my $attr ($class->compute_all_applicable_attributes()) {
         $attr->initialize_instance_slot($meta_instance, $instance, \%params);
     }

diff --git a/t/102_InsideOutClass_test.t b/t/102_InsideOutClass_test.t
index 658930e..ffd36eb 100644 (file)
--- a/t/102_InsideOutClass_test.t
+++ b/t/102_InsideOutClass_test.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 65;
+use Test::More tests => 85;
 use File::Spec;
 
 BEGIN { 
@@ -173,3 +173,34 @@ is($baz->foo(), 'This is Bar::Baz::foo', '... Bar::Baz::foo == "This is Bar"');
 is($baz->get_bar(), 'FOO is BAR', '... Bar::Baz::bar has been initialized');
 is($baz->bling(), 'Baz::bling', '... Bar::Baz::bling has been initialized');
 
+{
+    no strict 'refs';
+    
+    ok(*{'Foo::foo'}{HASH}, '... there is a foo package variable in Foo');
+    ok(*{'Foo::bar'}{HASH}, '... there is a bar package variable in Foo');
+
+    is(scalar(keys(%{'Foo::foo'})), 4, '... got the right number of entries for Foo::foo');
+    is(scalar(keys(%{'Foo::bar'})), 4, '... got the right number of entries for Foo::bar');    
+
+    ok(!*{'Bar::foo'}{HASH}, '... no foo package variable in Bar');
+    ok(!*{'Bar::bar'}{HASH}, '... no bar package variable in Bar');
+    ok(*{'Bar::baz'}{HASH}, '... there is a baz package variable in Bar');
+
+    is(scalar(keys(%{'Bar::foo'})), 0, '... got the right number of entries for Bar::foo');
+    is(scalar(keys(%{'Bar::bar'})), 0, '... got the right number of entries for Bar::bar');
+    is(scalar(keys(%{'Bar::baz'})), 2, '... got the right number of entries for Bar::baz');
+    
+    ok(*{'Baz::bling'}{HASH}, '... there is a bar package variable in Baz');
+
+    is(scalar(keys(%{'Baz::bling'})), 1, '... got the right number of entries for Baz::bling');        
+    
+    ok(!*{'Bar::Baz::foo'}{HASH}, '... no foo package variable in Bar::Baz');
+    ok(!*{'Bar::Baz::bar'}{HASH}, '... no bar package variable in Bar::Baz');
+    ok(!*{'Bar::Baz::baz'}{HASH}, '... no baz package variable in Bar::Baz');
+    ok(!*{'Bar::Baz::bling'}{HASH}, '... no bar package variable in Baz::Baz');
+
+    is(scalar(keys(%{'Bar::Baz::foo'})), 0, '... got the right number of entries for Bar::Baz::foo');
+    is(scalar(keys(%{'Bar::Baz::bar'})), 0, '... got the right number of entries for Bar::Baz::bar');
+    is(scalar(keys(%{'Bar::Baz::baz'})), 0, '... got the right number of entries for Bar::Baz::baz');    
+    is(scalar(keys(%{'Bar::Baz::bling'})), 0, '... got the right number of entries for Bar::Baz::bling');        
+}
\ No newline at end of file