initial test for coerce
Arthur Axel 'fREW' Schmidt [Sat, 13 Nov 2010 05:53:08 +0000 (23:53 -0600)]
t/accessor-coerce.t [new file with mode: 0644]

diff --git a/t/accessor-coerce.t b/t/accessor-coerce.t
new file mode 100644 (file)
index 0000000..76381bd
--- /dev/null
@@ -0,0 +1,85 @@
+use strictures 1;
+use Test::More;
+use Test::Fatal;
+
+sub run_for {
+  my $class = shift;
+
+  my $obj = $class->new(plus_three => 1);
+
+  is($obj->plus_three, 4, "initial value set (${class})");
+
+  $obj->plus_three(4);
+
+  is($obj->plus_three, 7, 'Value changes after set');
+}
+
+{
+  package Foo;
+
+  use Moo;
+
+  has plus_three => (
+    is => 'rw',
+    coerce => sub { $_[0] + 3 }
+  );
+}
+
+run_for 'Foo';
+
+{
+  package Bar;
+
+  use Sub::Quote;
+  use Moo;
+
+  has plus_three => (
+    is => 'rw',
+    coerce => quote_sub q{
+      my ($x) = @_;
+      $x + 3
+    }
+  );
+}
+
+run_for 'Bar';
+
+{
+  package Baz;
+
+  use Sub::Quote;
+  use Moo;
+
+  has plus_three => (
+    is => 'rw',
+    isa => quote_sub(
+      q{
+        my ($value) = @_;
+        $value + $plus
+      },
+      { '$plus' => \3 }
+    )
+  );
+}
+
+run_for 'Baz';
+
+{
+  package Biff;
+
+  use Sub::Quote;
+  use Moo;
+
+  has dies => (
+    is => 'rw',
+    isa => quote_sub(
+      q{
+        die 'could not add three!'
+      },
+    )
+  );
+}
+
+like exception { Biff->new(plus_three => 1) }, 'could not add three!', 'Exception properly thrown';
+
+done_testing;