summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rwxr-xr-xt/extending/class.t24
-rwxr-xr-xt/extending/file.t22
-rwxr-xr-xt/extending/method.t21
-rw-r--r--t/lib/AtomicMethod.pm27
-rw-r--r--t/lib/AtomicMethod/Role/Method.pm15
-rw-r--r--t/lib/Command.pm31
-rw-r--r--t/lib/Command/Role/Class.pm26
-rw-r--r--t/lib/Command/Role/Method.pm4
-rw-r--r--t/lib/FileAttributes.pm29
9 files changed, 199 insertions, 0 deletions
diff --git a/t/extending/class.t b/t/extending/class.t
new file mode 100755
index 0000000..194cf4c
--- /dev/null
+++ b/t/extending/class.t
@@ -0,0 +1,24 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+
+{
+ package Foo;
+ use Moose;
+ use Command;
+
+ sub foo {
+ }
+
+ command bar => sub {
+ };
+}
+
+ok(Foo->meta->has_method('bar'));
+is_deeply([Foo->meta->get_all_commands], [Foo->meta->get_method('bar')]);
+ok(Foo->meta->has_command('bar'));
+ok(!Foo->meta->has_command('foo'));
+
+done_testing;
diff --git a/t/extending/file.t b/t/extending/file.t
new file mode 100755
index 0000000..c6868cd
--- /dev/null
+++ b/t/extending/file.t
@@ -0,0 +1,22 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+use lib 't/lib';
+
+{
+ package Foo;
+ use Moose;
+ use FileAttributes;
+
+ has_file 'foo';
+ has_dir 'bar' => (required => 1);
+}
+
+my $foo = Foo->new(bar => '.');
+isa_ok($foo->bar, 'Path::Class::Dir');
+
+throws_ok { Foo->new(foo => 'test.pl') } qr/required/, "bar is required";
+
+done_testing;
diff --git a/t/extending/method.t b/t/extending/method.t
new file mode 100755
index 0000000..8599720
--- /dev/null
+++ b/t/extending/method.t
@@ -0,0 +1,21 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Test::Output;
+use lib 't/lib';
+
+{
+ package Foo;
+ use Moose;
+ use AtomicMethod;
+
+ atomic_method foo => sub {
+ warn "in foo\n";
+ };
+}
+
+my $foo = Foo->new;
+stderr_is(sub { $foo->foo }, "locking...\nin foo\nunlocking...\n");
+
+done_testing;
diff --git a/t/lib/AtomicMethod.pm b/t/lib/AtomicMethod.pm
new file mode 100644
index 0000000..652159a
--- /dev/null
+++ b/t/lib/AtomicMethod.pm
@@ -0,0 +1,27 @@
+package AtomicMethod;
+use MooseX::Exporter::Easy;
+
+sub _atomic_method_meta {
+ my ($meta) = @_;
+ Moose::Meta::Class->create_anon_class(
+ superclasses => [$meta->method_metaclass],
+ roles => ['AtomicMethod::Role::Method'],
+ cache => 1,
+ )->name;
+}
+
+with_meta atomic_method => sub {
+ my ($meta, $name, $code) = @_;
+ $meta->add_method(
+ $name => _atomic_method_meta($meta)->wrap(
+ $code,
+ name => $name,
+ package_name => $meta->name,
+ associated_metaclass => $meta
+ ),
+ );
+};
+
+export;
+
+1;
diff --git a/t/lib/AtomicMethod/Role/Method.pm b/t/lib/AtomicMethod/Role/Method.pm
new file mode 100644
index 0000000..e11f506
--- /dev/null
+++ b/t/lib/AtomicMethod/Role/Method.pm
@@ -0,0 +1,15 @@
+package AtomicMethod::Role::Method;
+use Moose::Role;
+
+around wrap => sub {
+ my ($orig, $self, $body, @args) = @_;
+ my $new_body = sub {
+ warn "locking...\n";
+ my @ret = $body->(@_); # XXX: context
+ warn "unlocking...\n";
+ return @ret;
+ };
+ $self->$orig($new_body, @args);
+};
+
+1;
diff --git a/t/lib/Command.pm b/t/lib/Command.pm
new file mode 100644
index 0000000..b39b8b5
--- /dev/null
+++ b/t/lib/Command.pm
@@ -0,0 +1,31 @@
+package Command;
+use MooseX::Exporter::Easy;
+
+class_metaroles {
+ class => ['Command::Role::Class'],
+};
+
+sub _command_method_meta {
+ my ($meta) = @_;
+ Moose::Meta::Class->create_anon_class(
+ superclasses => [$meta->method_metaclass],
+ roles => ['Command::Role::Method'],
+ cache => 1,
+ )->name;
+}
+
+with_meta command => sub {
+ my ($meta, $name, $code) = @_;
+ $meta->add_method(
+ $name => _command_method_meta($meta)->wrap(
+ $code,
+ name => $name,
+ package_name => $meta->name,
+ associated_metaclass => $meta
+ ),
+ );
+};
+
+export;
+
+1;
diff --git a/t/lib/Command/Role/Class.pm b/t/lib/Command/Role/Class.pm
new file mode 100644
index 0000000..78b48db
--- /dev/null
+++ b/t/lib/Command/Role/Class.pm
@@ -0,0 +1,26 @@
+package Command::Role::Class;
+use Moose::Role;
+
+sub get_all_commands {
+ my ($self) = @_;
+ grep { Moose::Util::does_role($_, 'Command::Role::Method') }
+ $self->get_all_methods;
+}
+
+sub has_command {
+ my ($self, $name) = @_;
+ my $method = $self->find_method_by_name($name);
+ return unless $method;
+ return Moose::Util::does_role($method, 'Command::Role::Method');
+}
+
+sub get_command {
+ my ($self, $name) = @_;
+ my $method = $self->find_method_by_name($name);
+ return unless $method;
+ return Moose::Util::does_role($method, 'Command::Role::Method')
+ ? $method
+ : ();
+}
+
+1;
diff --git a/t/lib/Command/Role/Method.pm b/t/lib/Command/Role/Method.pm
new file mode 100644
index 0000000..29152ac
--- /dev/null
+++ b/t/lib/Command/Role/Method.pm
@@ -0,0 +1,4 @@
+package Command::Role::Method;
+use Moose::Role;
+
+1;
diff --git a/t/lib/FileAttributes.pm b/t/lib/FileAttributes.pm
new file mode 100644
index 0000000..04e6f2e
--- /dev/null
+++ b/t/lib/FileAttributes.pm
@@ -0,0 +1,29 @@
+package FileAttributes;
+use MooseX::Exporter::Easy;
+use MooseX::Types::Path::Class qw(File Dir);
+
+with_meta has_file => sub {
+ my ($meta, $name, %options) = @_;
+ $meta->add_attribute(
+ $name,
+ is => 'ro',
+ isa => File,
+ coerce => 1,
+ %options,
+ );
+};
+
+with_meta has_dir => sub {
+ my ($meta, $name, %options) = @_;
+ $meta->add_attribute(
+ $name,
+ is => 'ro',
+ isa => Dir,
+ coerce => 1,
+ %options,
+ );
+};
+
+export;
+
+1;