From: Jesse Luehrs <doy@tozt.net>
Date: Mon, 11 Oct 2010 18:05:40 +0000 (-0500)
Subject: test for non-lvalue instances
X-Git-Tag: 1.16~50
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0cfc2850140b8e2bf37ccbb3ae3e0053e69113ab;p=gitmo%2FMoose.git

test for non-lvalue instances
---

diff --git a/t/070_native_traits/103_custom_instance.t b/t/070_native_traits/103_custom_instance.t
new file mode 100644
index 0000000..ed297bb
--- /dev/null
+++ b/t/070_native_traits/103_custom_instance.t
@@ -0,0 +1,88 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+use Test::Moose;
+
+{
+    package ValueContainer;
+    use Moose;
+
+    has value => (
+        is => 'rw',
+    );
+}
+
+{
+    package Foo::Meta::Instance;
+    use Moose::Role;
+
+    around get_slot_value => sub {
+        my $orig = shift;
+        my $self = shift;
+        my ($instance, $slot_name) = @_;
+        my $value = $self->$orig(@_);
+        if ($value->isa('ValueContainer')) {
+            $value = $value->value;
+        }
+        return $value;
+    };
+
+    around inline_get_slot_value => sub {
+        my $orig = shift;
+        my $self = shift;
+        my $value = $self->$orig(@_);
+        return q[do {] . "\n"
+             . q[    my $value = ] . $value . q[;] . "\n"
+             . q[    if ($value->isa('ValueContainer')) {] . "\n"
+             . q[        $value = $value->value;] . "\n"
+             . q[    }] . "\n"
+             . q[    $value] . "\n"
+             . q[}];
+    };
+
+    sub inline_get_is_lvalue { 0 }
+}
+
+{
+    package Foo;
+    use Moose;
+    Moose::Util::MetaRole::apply_metaroles(
+        for => __PACKAGE__,
+        class_metaroles => {
+            instance => ['Foo::Meta::Instance'],
+        }
+    );
+
+    ::lives_ok {
+        has foo => (
+            traits  => ['String'],
+            is      => 'ro',
+            isa     => 'Str',
+            default => '',
+            handles => {
+                append_foo => 'append',
+            },
+        );
+    }
+}
+
+with_immutable {
+    {
+        my $foo = Foo->new(foo => 'a');
+        is($foo->foo, 'a');
+        $foo->append_foo('b');
+        is($foo->foo, 'ab');
+    }
+
+    {
+        my $foo = Foo->new(foo => '');
+        $foo->{foo} = ValueContainer->new(value => 'a');
+        is($foo->foo, 'a');
+        $foo->append_foo('b');
+        is($foo->foo, 'ab');
+    }
+} 'Foo';
+
+done_testing;