From: Jesse Luehrs Date: Fri, 13 May 2011 16:12:40 +0000 (-0500) Subject: more tests X-Git-Tag: 2.0100~100 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ec118926b577350961f578eaeb387a02ffb0b202;p=gitmo%2FMoose.git more tests --- diff --git a/t/attributes/clone_weak.t b/t/attributes/clone_weak.t index 55a0604..1f5162d 100644 --- a/t/attributes/clone_weak.t +++ b/t/attributes/clone_weak.t @@ -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 { '<>' . 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;