Add another test file
Shawn M Moore [Sun, 9 Nov 2008 07:26:41 +0000 (07:26 +0000)]
t/003-apply.t [new file with mode: 0644]

diff --git a/t/003-apply.t b/t/003-apply.t
new file mode 100644 (file)
index 0000000..51f155a
--- /dev/null
@@ -0,0 +1,71 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 1;
+use Test::Exception;
+
+do {
+    package MyRole::Storage;
+    use MooseX::Role::Parameterized;
+    use Moose::Util::TypeConstraints;
+
+    parameter format => (
+        is       => 'ro',
+        isa      => (enum ['Dumper', 'Storable']),
+        required => 1,
+    );
+
+    parameter freeze_method => (
+        is      => 'ro',
+        isa     => 'Str',
+        lazy    => 1,
+        default => sub { "freeze_" . shift->format },
+    );
+
+    parameter thaw_method => (
+        is      => 'ro',
+        isa     => 'Str',
+        lazy    => 1,
+        default => sub { "thaw_" . shift->format },
+    );
+
+    role {
+        my $p = shift;
+        my $format = $p->format;
+
+        my ($freezer, $thawer);
+
+        if ($format eq 'Dumper') {
+            require Data::Dumper;
+            $freezer = \&Data::Dumper::Dumper;
+            $thawer  = sub { eval "@_" };
+
+        }
+        elsif ($format eq 'Storable') {
+            require Storable;
+            $freezer = \&Storable::nfreeze;
+            $thawer  = \&Storable::thaw;
+        }
+        else {
+            die "Unknown format ($format)";
+        }
+
+        method $p->freeze_method => $freezer;
+        method $p->thaw_method   => $thawer;
+    };
+};
+
+throws_ok {
+    package MyClass::Error;
+    use Moose;
+    with 'MyRole::Storage';
+} qr/^Attribute \(format\) is required/;
+
+do {
+    package MyClass::Dumper;
+    use Moose;
+    with 'MyRole::Storage' => {
+        format => 'Dumper',
+    };
+};
+