t/attributes/clone_weak.t

   1 use strict;
   2 use warnings;
   3 use Test::More;
   4
   5 {
   6     package Foo;
   7     use Moose;
   8
   9     has bar => (
  10         is       => 'ro',
  11         weak_ref => 1,
  12     );
  13 }
  14
  15 {
  16     package MyScopeGuard;
  17
  18     sub new {
  19         my ($class, $cb) = @_;
  20         bless { cb => $cb }, $class;
  21     }
  22
  23     sub DESTROY { shift->{cb}->() }
  24 }
  25
  26 {
  27     my $destroyed = 0;
  28
  29     my $foo = do {
  30         my $bar = MyScopeGuard->new(sub { $destroyed++ });
  31         my $foo = Foo->new({ bar => $bar });
  32         my $clone = $foo->meta->clone_object($foo);
  33
  34         is $destroyed, 0;
  35
  36         $clone;
  37     };
  38
  39     isa_ok($foo, 'Foo');
  40     is $foo->bar, undef;
  41     is $destroyed, 1;
  42 }
  43
  44 {
  45     my $clone;
  46     {
  47         my $anon = Moose::Meta::Class->create_anon_class;
  48
  49         my $foo = $anon->new_object;
  50         isa_ok($foo, $anon->name);
  51         ok(Class::MOP::class_of($foo), "has a metaclass");
  52
  53         $clone = $anon->clone_object($foo);
  54         isa_ok($clone, $anon->name);
  55         ok(Class::MOP::class_of($clone), "has a metaclass");
  56     }
  57
  58     ok(Class::MOP::class_of($clone), "still has a metaclass");
  59 }
  60
  61 {
  62     package Foo::Meta::Attr::Trait;
  63     use Moose::Role;
  64
  65     has value_slot => (
  66         is      => 'ro',
  67         isa     => 'Str',
  68         lazy    => 1,
  69         default => sub { shift->name },
  70     );
  71
  72     has count_slot => (
  73         is      => 'ro',
  74         isa     => 'Str',
  75         lazy    => 1,
  76         default => sub { '<<COUNT>>' . shift->name },
  77     );
  78
  79     sub slots {
  80         my $self = shift;
  81         return ($self->value_slot, $self->count_slot);
  82     }
  83
  84     sub _set_count {
  85         my $self = shift;
  86         my ($instance) = @_;
  87         my $mi = $self->associated_class->get_meta_instance;
  88         $mi->set_slot_value(
  89             $instance,
  90             $self->count_slot,
  91             ($mi->get_slot_value($instance, $self->count_slot) || 0) + 1,
  92         );
  93     }
  94
  95     sub _clear_count {
  96         my $self = shift;
  97         my ($instance) = @_;
  98         $self->associated_class->get_meta_instance->deinitialize_slot(
  99             $instance, $self->count_slot
 100         );
 101     }
 102
 103     sub has_count {
 104         my $self = shift;
 105         my ($instance) = @_;
 106         $self->associated_class->get_meta_instance->has_slot_value(
 107             $instance, $self->count_slot
 108         );
 109     }
 110
 111     sub count {
 112         my $self = shift;
 113         my ($instance) = @_;
 114         $self->associated_class->get_meta_instance->get_slot_value(
 115             $instance, $self->count_slot
 116         );
 117     }
 118
 119     after set_initial_value => sub {
 120         shift->_set_count(@_);
 121     };
 122
 123     after set_value => sub {
 124         shift->_set_count(@_);
 125     };
 126
 127     around _inline_instance_set => sub {
 128         my $orig = shift;
 129         my $self = shift;
 130         my ($instance) = @_;
 131
 132         my $mi = $self->associated_class->get_meta_instance;
 133
 134         return 'do { '
 135                  . $mi->inline_set_slot_value(
 136                        $instance,
 137                        $self->count_slot,
 138                        $mi->inline_get_slot_value(
 139                            $instance, $self->count_slot
 140                        ) . ' + 1'
 141                    ) . ';'
 142                  . $self->$orig(@_)
 143              . '}';
 144     };
 145
 146     after clear_value => sub {
 147         shift->_clear_count(@_);
 148     };
 149 }
 150
 151 {
 152     package Bar;
 153     use Moose;
 154     Moose::Util::MetaRole::apply_metaroles(
 155         for => __PACKAGE__,
 156         class_metaroles => {
 157             attribute => ['Foo::Meta::Attr::Trait'],
 158         },
 159     );
 160
 161     has baz => ( is => 'rw' );
 162 }
 163
 164 {
 165     my $attr = Bar->meta->find_attribute_by_name('baz');
 166
 167     my $bar = Bar->new(baz => 1);
 168     is($attr->count($bar), 1, "right count");
 169
 170     $bar->baz(2);
 171     is($attr->count($bar), 2, "right count");
 172
 173     my $clone = $bar->meta->clone_object($bar);
 174     is($attr->count($clone), $attr->count($bar), "right count");
 175 }
 176
 177 done_testing;