From d1bab5d4a5ea4100803c871461c62744767c514b Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Mon, 19 Jul 2010 19:21:54 -0500 Subject: a few more tests --- t/extending/class.t | 24 ++++++++++++++++++++++++ t/extending/file.t | 22 ++++++++++++++++++++++ t/extending/method.t | 21 +++++++++++++++++++++ t/lib/AtomicMethod.pm | 27 +++++++++++++++++++++++++++ t/lib/AtomicMethod/Role/Method.pm | 15 +++++++++++++++ t/lib/Command.pm | 31 +++++++++++++++++++++++++++++++ t/lib/Command/Role/Class.pm | 26 ++++++++++++++++++++++++++ t/lib/Command/Role/Method.pm | 4 ++++ t/lib/FileAttributes.pm | 29 +++++++++++++++++++++++++++++ 9 files changed, 199 insertions(+) create mode 100755 t/extending/class.t create mode 100755 t/extending/file.t create mode 100755 t/extending/method.t create mode 100644 t/lib/AtomicMethod.pm create mode 100644 t/lib/AtomicMethod/Role/Method.pm create mode 100644 t/lib/Command.pm create mode 100644 t/lib/Command/Role/Class.pm create mode 100644 t/lib/Command/Role/Method.pm create mode 100644 t/lib/FileAttributes.pm 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; -- cgit v1.2.3