trAvis - MANAGER

Edit File: 036_clone_weak.t

use strict;
use warnings;
use Test::More;

{
    package Foo;
    use Mouse;

has bar => (
        is       => 'ro',
        weak_ref => 1,
    );
}

{
    package MyScopeGuard;

sub new {
        my ($class, $cb) = @_;
        bless { cb => $cb }, $class;
    }

sub DESTROY { shift->{cb}->() }
}

{
    my $destroyed = 0;

my $foo = do {
        my $bar = MyScopeGuard->new(sub { $destroyed++ });
        my $foo = Foo->new({ bar => $bar });
        my $clone = $foo->meta->clone_object($foo);

is $destroyed, 0;

$clone;
    };

isa_ok($foo, 'Foo');
    is $foo->bar, undef;
    is $destroyed, 1;
}

{
    my $clone;
    {
        my $anon = Mouse::Meta::Class->create_anon_class;

my $foo = $anon->new_object;
        isa_ok($foo, $anon->name);
        ok(Mouse::Util::class_of($foo), "has a metaclass");

$clone = $anon->clone_object($foo);
        isa_ok($clone, $anon->name);
        ok(Mouse::Util::class_of($clone), "has a metaclass");
    }

ok(Mouse::Util::class_of($clone), "still has a metaclass");
}

=pod

{
    package Foo::Meta::Attr::Trait;
    use Mouse::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 Mouse;
    Mouse::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");
}

=cut

done_testing;