From: Stevan Little <stevan.little@iinteractive.com>
Date: Wed, 3 May 2006 20:50:55 +0000 (+0000)
Subject: tweaks
X-Git-Tag: 0_29_02~16
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d82060febb1988d53335b31f829bc50828ccc588;p=gitmo%2FClass-MOP.git

tweaks
---

diff --git a/MANIFEST b/MANIFEST
index 4e956fb..e21548a 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5,6 +5,8 @@ META.yml
 MANIFEST
 MANIFEST.SKIP
 README
+TODO
+examples/ArrayBasedStorage.pod
 examples/AttributesWithHistory.pod
 examples/C3MethodDispatchOrder.pod
 examples/ClassEncapsulatedAttributes.pod
@@ -16,6 +18,7 @@ lib/metaclass.pm
 lib/Class/MOP.pm
 lib/Class/MOP/Attribute.pm
 lib/Class/MOP/Class.pm
+lib/Class/MOP/Instance.pm
 lib/Class/MOP/Method.pm
 t/000_load.t
 t/001_basic.t
@@ -39,7 +42,12 @@ t/030_method.t
 t/031_method_modifiers.t
 t/040_metaclass.t
 t/041_metaclass_incompatability.t
+t/042_metaclass_incompatibility_dynamic.t
+t/043_instance_metaclass_incompatibility.t
+t/044_instance_metaclass_incompatibility_dynamic.t
 t/050_scala_style_mixin_composition.t
+t/060_instance.t
+t/061_instance_inline.t
 t/100_BinaryTree_test.t
 t/101_InstanceCountingClass_test.t
 t/102_InsideOutClass_test.t
@@ -48,6 +56,7 @@ t/104_AttributesWithHistory_test.t
 t/105_ClassEncapsulatedAttributes_test.t
 t/106_LazyClass_test.t
 t/107_C3MethodDispatchOrder_test.t
+t/108_ArrayBasedStorage_test.t
 t/200_Class_C3_compatibility.t
 t/300_random_eval_bug.t
 t/pod.t
diff --git a/examples/ArrayBasedStorage.pod b/examples/ArrayBasedStorage.pod
index 6df324a..c05fd12 100644
--- a/examples/ArrayBasedStorage.pod
+++ b/examples/ArrayBasedStorage.pod
@@ -48,11 +48,6 @@ sub set_slot_value {
     $instance->[ $self->{slot_index_map}->{$slot_name} ] = $value;
 }
 
-sub initialize_slot {
-    my ($self, $instance, $slot_name) = @_;
-    $instance->[ $self->{slot_index_map}->{$slot_name} ] = undef;
-}
-
 sub is_slot_initialized {
     # NOTE:
     # maybe use CLOS's *special-unbound-value*
diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 17da3df..85198f9 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -87,7 +87,8 @@ sub meta { Class::MOP::Class->initialize(blessed($_[0]) || $_[0]) }
         my $self = shift;
 
         # this is always okay ...
-        return if blessed($self) eq 'Class::MOP::Class';
+        return if blessed($self)            eq 'Class::MOP::Class'   && 
+                  $self->instance_metaclass eq 'Class::MOP::Instance';
 
         my @class_list = $self->class_precedence_list;
         shift @class_list; # shift off $self->name
@@ -246,6 +247,13 @@ sub superclasses {
     if (@_) {
         my @supers = @_;
         @{$self->name . '::ISA'} = @supers;
+        # NOTE:
+        # we need to check the metaclass 
+        # compatability here so that we can 
+        # be sure that the superclass is 
+        # not potentially creating an issues 
+        # we don't know about
+        $self->check_metaclass_compatability();
     }
     @{$self->name . '::ISA'};
 }
diff --git a/lib/Class/MOP/Instance.pm b/lib/Class/MOP/Instance.pm
index 66e1f45..f9a34da 100644
--- a/lib/Class/MOP/Instance.pm
+++ b/lib/Class/MOP/Instance.pm
@@ -73,7 +73,7 @@ sub set_slot_value {
 
 sub initialize_slot {
     my ($self, $instance, $slot_name) = @_;
-    $instance->{$slot_name} = undef;
+    $self->set_slot_value($instance, $slot_name, undef);
 }
 
 sub initialize_all_slots {
diff --git a/lib/metaclass.pm b/lib/metaclass.pm
index b5658dc..b52022f 100644
--- a/lib/metaclass.pm
+++ b/lib/metaclass.pm
@@ -22,8 +22,8 @@ sub import {
         ($metaclass->isa('Class::MOP::Class'))
             || confess 'The metaclass must be derived from Class::MOP::Class';        
     }
-    my %options   = @_;
-    my $package   = caller();
+    my %options = @_;
+    my $package = caller();
     
     # create a meta object so we can install &meta
     my $meta = $metaclass->initialize($package => %options);
diff --git a/t/042_metaclass_incompatibility_dynamic.t b/t/042_metaclass_incompatibility_dynamic.t
new file mode 100644
index 0000000..8608bb3
--- /dev/null
+++ b/t/042_metaclass_incompatibility_dynamic.t
@@ -0,0 +1,70 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+
+BEGIN {
+    use_ok('metaclass');    
+}
+
+# meta classes
+{
+    package Foo::Meta;
+    use base 'Class::MOP::Class';
+    
+    package Bar::Meta;
+    use base 'Class::MOP::Class';
+    
+    package FooBar::Meta;
+    use base 'Foo::Meta', 'Bar::Meta';
+}
+
+$@ = undef;
+eval {
+    package Foo;
+    metaclass->import('Foo::Meta');
+};
+ok(!$@, '... Foo.meta => Foo::Meta is compatible') || diag $@;
+
+$@ = undef;
+eval {
+    package Bar;
+    metaclass->import('Bar::Meta');
+};
+ok(!$@, '... Bar.meta => Bar::Meta is compatible') || diag $@;
+
+$@ = undef;
+eval {
+    package Foo::Foo;
+    metaclass->import('Bar::Meta');
+    Foo::Foo->meta->superclasses('Foo');    
+};
+ok($@, '... Foo::Foo.meta => Bar::Meta is not compatible') || diag $@;
+
+$@ = undef;
+eval {
+    package Bar::Bar;
+    metaclass->import('Foo::Meta');
+    Bar::Bar->meta->superclasses('Bar');
+};
+ok($@, '... Bar::Bar.meta => Foo::Meta is not compatible') || diag $@;
+
+$@ = undef;
+eval {
+    package FooBar;
+    metaclass->import('FooBar::Meta');
+    FooBar->meta->superclasses('Foo');    
+};
+ok(!$@, '... FooBar.meta => FooBar::Meta is compatible') || diag $@;
+
+$@ = undef;
+eval {
+    package FooBar2;
+    metaclass->import('FooBar::Meta');
+    FooBar2->meta->superclasses('Bar');    
+};
+ok(!$@, '... FooBar2.meta => FooBar::Meta is compatible') || diag $@;
+
+
diff --git a/t/043_instance_metaclass_incompatibility.t b/t/043_instance_metaclass_incompatibility.t
new file mode 100644
index 0000000..9c53486
--- /dev/null
+++ b/t/043_instance_metaclass_incompatibility.t
@@ -0,0 +1,70 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+
+BEGIN {
+    use_ok('metaclass');    
+}
+
+# meta classes
+{   
+    package Foo::Meta::Instance;
+    use base 'Class::MOP::Instance';    
+    
+    package Bar::Meta::Instance;
+    use base 'Class::MOP::Instance';    
+    
+    package FooBar::Meta::Instance;
+    use base 'Foo::Meta::Instance', 'Bar::Meta::Instance';
+}
+
+$@ = undef;
+eval {
+    package Foo;
+    metaclass->import(':instance_metaclass' => 'Foo::Meta::Instance');
+};
+ok(!$@, '... Foo.meta => Foo::Meta is compatible') || diag $@;
+
+$@ = undef;
+eval {
+    package Bar;
+    metaclass->import(':instance_metaclass' => 'Bar::Meta::Instance');
+};
+ok(!$@, '... Bar.meta => Bar::Meta is compatible') || diag $@;
+
+$@ = undef;
+eval {
+    package Foo::Foo;
+    use base 'Foo';
+    metaclass->import(':instance_metaclass' => 'Bar::Meta::Instance');
+};
+ok($@, '... Foo::Foo.meta => Bar::Meta is not compatible') || diag $@;
+
+$@ = undef;
+eval {
+    package Bar::Bar;
+    use base 'Bar';
+    metaclass->import(':instance_metaclass' => 'Foo::Meta::Instance');    
+};
+ok($@, '... Bar::Bar.meta => Foo::Meta is not compatible') || diag $@;
+
+$@ = undef;
+eval {
+    package FooBar;
+    use base 'Foo';
+    metaclass->import(':instance_metaclass' => 'FooBar::Meta::Instance');    
+};
+ok(!$@, '... FooBar.meta => FooBar::Meta is compatible') || diag $@;
+
+$@ = undef;
+eval {
+    package FooBar2;
+    use base 'Bar';
+    metaclass->import(':instance_metaclass' => 'FooBar::Meta::Instance');    
+};
+ok(!$@, '... FooBar2.meta => FooBar::Meta is compatible') || diag $@;
+
+
diff --git a/t/044_instance_metaclass_incompatibility_dynamic.t b/t/044_instance_metaclass_incompatibility_dynamic.t
new file mode 100644
index 0000000..e52b24a
--- /dev/null
+++ b/t/044_instance_metaclass_incompatibility_dynamic.t
@@ -0,0 +1,70 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+
+BEGIN {
+    use_ok('metaclass');    
+}
+
+# meta classes
+{   
+    package Foo::Meta::Instance;
+    use base 'Class::MOP::Instance';    
+    
+    package Bar::Meta::Instance;
+    use base 'Class::MOP::Instance';    
+    
+    package FooBar::Meta::Instance;
+    use base 'Foo::Meta::Instance', 'Bar::Meta::Instance';
+}
+
+$@ = undef;
+eval {
+    package Foo;
+    metaclass->import(':instance_metaclass' => 'Foo::Meta::Instance');
+};
+ok(!$@, '... Foo.meta => Foo::Meta is compatible') || diag $@;
+
+$@ = undef;
+eval {
+    package Bar;
+    metaclass->import(':instance_metaclass' => 'Bar::Meta::Instance');
+};
+ok(!$@, '... Bar.meta => Bar::Meta is compatible') || diag $@;
+
+$@ = undef;
+eval {
+    package Foo::Foo;
+    metaclass->import(':instance_metaclass' => 'Bar::Meta::Instance');
+    Foo::Foo->meta->superclasses('Foo');    
+};
+ok($@, '... Foo::Foo.meta => Bar::Meta is not compatible') || diag $@;
+
+$@ = undef;
+eval {
+    package Bar::Bar;
+    metaclass->import(':instance_metaclass' => 'Foo::Meta::Instance');  
+    Bar::Bar->meta->superclasses('Bar');
+};
+ok($@, '... Bar::Bar.meta => Foo::Meta is not compatible') || diag $@;
+
+$@ = undef;
+eval {
+    package FooBar;
+    metaclass->import(':instance_metaclass' => 'FooBar::Meta::Instance');   
+    FooBar->meta->superclasses('Foo');    
+};
+ok(!$@, '... FooBar.meta => FooBar::Meta is compatible') || diag $@;
+
+$@ = undef;
+eval {
+    package FooBar2;
+    metaclass->import(':instance_metaclass' => 'FooBar::Meta::Instance');   
+    FooBar2->meta->superclasses('Bar');    
+};
+ok(!$@, '... FooBar2.meta => FooBar::Meta is compatible') || diag $@;
+
+