t/070_native_traits/103_custom_instance.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More;
   5 use Test::Exception;
   6 use Test::Moose;
   7
   8 {
   9     package ValueContainer;
  10     use Moose;
  11
  12     has value => (
  13         is => 'rw',
  14     );
  15 }
  16
  17 {
  18     package Foo::Meta::Instance;
  19     use Moose::Role;
  20
  21     around get_slot_value => sub {
  22         my $orig = shift;
  23         my $self = shift;
  24         my ($instance, $slot_name) = @_;
  25         my $value = $self->$orig(@_);
  26         if ($value->isa('ValueContainer')) {
  27             $value = $value->value;
  28         }
  29         return $value;
  30     };
  31
  32     around inline_get_slot_value => sub {
  33         my $orig = shift;
  34         my $self = shift;
  35         my $value = $self->$orig(@_);
  36         return q[do {] . "\n"
  37              . q[    my $value = ] . $value . q[;] . "\n"
  38              . q[    if ($value->isa('ValueContainer')) {] . "\n"
  39              . q[        $value = $value->value;] . "\n"
  40              . q[    }] . "\n"
  41              . q[    $value] . "\n"
  42              . q[}];
  43     };
  44
  45     sub inline_get_is_lvalue { 0 }
  46 }
  47
  48 {
  49     package Foo;
  50     use Moose;
  51     Moose::Util::MetaRole::apply_metaroles(
  52         for => __PACKAGE__,
  53         class_metaroles => {
  54             instance => ['Foo::Meta::Instance'],
  55         }
  56     );
  57
  58     ::lives_ok {
  59         has foo => (
  60             traits  => ['String'],
  61             is      => 'ro',
  62             isa     => 'Str',
  63             default => '',
  64             handles => {
  65                 append_foo => 'append',
  66             },
  67         );
  68     }
  69 }
  70
  71 with_immutable {
  72     {
  73         my $foo = Foo->new(foo => 'a');
  74         is($foo->foo, 'a');
  75         $foo->append_foo('b');
  76         is($foo->foo, 'ab');
  77     }
  78
  79     {
  80         my $foo = Foo->new(foo => '');
  81         $foo->{foo} = ValueContainer->new(value => 'a');
  82         is($foo->foo, 'a');
  83         $foo->append_foo('b');
  84         is($foo->foo, 'ab');
  85     }
  86 } 'Foo';
  87
  88 done_testing;