extra test from FAIL_modify_lazy_handlers
Matt S Trout [Tue, 26 Jun 2012 19:16:21 +0000 (19:16 +0000)]
t/lib/ClassicObject.pm [new file with mode: 0644]
t/lib/MooObjectWithDelegate.pm [new file with mode: 0644]
t/modify_lazy_handlers.t [new file with mode: 0644]

diff --git a/t/lib/ClassicObject.pm b/t/lib/ClassicObject.pm
new file mode 100644 (file)
index 0000000..1df3a04
--- /dev/null
@@ -0,0 +1,10 @@
+package ClassicObject;
+
+sub new {
+    my ($class, %args) = @_;
+    bless \%args, 'ClassicObject';
+}
+
+sub connect { 'a' }
+
+1;
diff --git a/t/lib/MooObjectWithDelegate.pm b/t/lib/MooObjectWithDelegate.pm
new file mode 100644 (file)
index 0000000..db2be38
--- /dev/null
@@ -0,0 +1,27 @@
+package MooObjectWithDelegate;
+use ClassicObject;
+use Moo;
+
+has 'delegated' => (
+  is => 'ro',
+  isa => sub {
+    do { $_[0] && blessed($_[0]) }
+      or die "Not an Object!";
+  },
+  lazy => 1,
+  builder => '_build_delegated',
+  handles => [qw/connect/],
+);
+
+sub _build_delegated {
+  my $self = shift;
+  return ClassicObject->new;
+}
+
+around 'connect', sub {
+  my ($orig, $self, @args) = @_;
+  return $self->$orig(@args) . 'b';
+};
+
+
+1;
diff --git a/t/modify_lazy_handlers.t b/t/modify_lazy_handlers.t
new file mode 100644 (file)
index 0000000..b52ddac
--- /dev/null
@@ -0,0 +1,23 @@
+use strictures 1;
+use Test::More;
+use lib qw(t/lib);
+
+use_ok 'MooObjectWithDelegate';
+
+{
+    package MooObjectWithDelegate;
+    use Moo;
+
+    around 'connect', sub {
+      my ($orig, $self, @args) = @_;
+      return $self->$orig(@args) . 'c';
+    };
+}
+
+ok my $moo_object = MooObjectWithDelegate->new,
+  'got object';
+
+is $moo_object->connect, 'abc',
+  'got abc';
+
+done_testing;