more tests
Jesse Luehrs [Fri, 13 May 2011 16:12:40 +0000 (11:12 -0500)]
t/attributes/clone_weak.t

index 55a0604..1f5162d 100644 (file)
@@ -41,4 +41,137 @@ use Test::More;
     is $destroyed, 1;
 }
 
+{
+    my $clone;
+    {
+        my $anon = Moose::Meta::Class->create_anon_class;
+
+        my $foo = $anon->new_object;
+        isa_ok($foo, $anon->name);
+        ok(Class::MOP::class_of($foo), "has a metaclass");
+
+        $clone = $anon->clone_object($foo);
+        isa_ok($clone, $anon->name);
+        ok(Class::MOP::class_of($clone), "has a metaclass");
+    }
+
+    ok(Class::MOP::class_of($clone), "still has a metaclass");
+}
+
+{
+    package Foo::Meta::Attr::Trait;
+    use Moose::Role;
+
+    has value_slot => (
+        is      => 'ro',
+        isa     => 'Str',
+        lazy    => 1,
+        default => sub { shift->name },
+    );
+
+    has count_slot => (
+        is      => 'ro',
+        isa     => 'Str',
+        lazy    => 1,
+        default => sub { '<<COUNT>>' . shift->name },
+    );
+
+    sub slots {
+        my $self = shift;
+        return ($self->value_slot, $self->count_slot);
+    }
+
+    sub _set_count {
+        my $self = shift;
+        my ($instance) = @_;
+        my $mi = $self->associated_class->get_meta_instance;
+        $mi->set_slot_value(
+            $instance,
+            $self->count_slot,
+            ($mi->get_slot_value($instance, $self->count_slot) || 0) + 1,
+        );
+    }
+
+    sub _clear_count {
+        my $self = shift;
+        my ($instance) = @_;
+        $self->associated_class->get_meta_instance->deinitialize_slot(
+            $instance, $self->count_slot
+        );
+    }
+
+    sub has_count {
+        my $self = shift;
+        my ($instance) = @_;
+        $self->associated_class->get_meta_instance->has_slot_value(
+            $instance, $self->count_slot
+        );
+    }
+
+    sub count {
+        my $self = shift;
+        my ($instance) = @_;
+        $self->associated_class->get_meta_instance->get_slot_value(
+            $instance, $self->count_slot
+        );
+    }
+
+    after set_initial_value => sub {
+        shift->_set_count(@_);
+    };
+
+    after set_value => sub {
+        shift->_set_count(@_);
+    };
+
+    around _inline_instance_set => sub {
+        my $orig = shift;
+        my $self = shift;
+        my ($instance) = @_;
+
+        my $mi = $self->associated_class->get_meta_instance;
+
+        return 'do { '
+                 . $mi->inline_set_slot_value(
+                       $instance,
+                       $self->count_slot,
+                       $mi->inline_get_slot_value(
+                           $instance, $self->count_slot
+                       ) . ' + 1'
+                   ) . ';'
+                 . $self->$orig(@_)
+             . '}';
+    };
+
+    after clear_value => sub {
+        shift->_clear_count(@_);
+    };
+}
+
+{
+    package Bar;
+    use Moose;
+    Moose::Util::MetaRole::apply_metaroles(
+        for => __PACKAGE__,
+        class_metaroles => {
+            attribute => ['Foo::Meta::Attr::Trait'],
+        },
+    );
+
+    has baz => ( is => 'rw' );
+}
+
+{
+    my $attr = Bar->meta->find_attribute_by_name('baz');
+
+    my $bar = Bar->new(baz => 1);
+    is($attr->count($bar), 1, "right count");
+
+    $bar->baz(2);
+    is($attr->count($bar), 2, "right count");
+
+    my $clone = $bar->meta->clone_object($bar);
+    is($attr->count($clone), $attr->count($bar), "right count");
+}
+
 done_testing;