summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2010-06-24 13:41:55 -0500
committerJesse Luehrs <doy@tozt.net>2010-06-24 13:42:14 -0500
commite487cbac42aac4f6bded38ffc91b66e1d1d1ddc6 (patch)
tree5a155c9dd731e9d382de5866f55d235f8ebe02ee
parentecd91561e832c88e486856d7e40d0b940d1bde5c (diff)
downloadmoosex-attribute-shorthand-e487cbac42aac4f6bded38ffc91b66e1d1d1ddc6.tar.gz
moosex-attribute-shorthand-e487cbac42aac4f6bded38ffc91b66e1d1d1ddc6.zip
make it work for role attributes
-rw-r--r--dist.ini1
-rw-r--r--lib/MooseX/Attribute/Shorthand.pm3
-rw-r--r--t/004-roles.t89
3 files changed, 93 insertions, 0 deletions
diff --git a/dist.ini b/dist.ini
index fb58d8c..7a932a1 100644
--- a/dist.ini
+++ b/dist.ini
@@ -8,3 +8,4 @@ abstract =
[@Classic]
[Prereq]
+Moose = 1.09
diff --git a/lib/MooseX/Attribute/Shorthand.pm b/lib/MooseX/Attribute/Shorthand.pm
index 12e57fa..aef1a0f 100644
--- a/lib/MooseX/Attribute/Shorthand.pm
+++ b/lib/MooseX/Attribute/Shorthand.pm
@@ -63,6 +63,9 @@ sub import {
class_metaroles => {
attribute => [$role->name],
},
+ role_metaroles => {
+ class_attribute => [$role->name],
+ }
);
}
diff --git a/t/004-roles.t b/t/004-roles.t
new file mode 100644
index 0000000..6b32005
--- /dev/null
+++ b/t/004-roles.t
@@ -0,0 +1,89 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+
+{
+ package Foo::Role;
+ use Moose::Role;
+ use MooseX::Attribute::Shorthand string => {
+ is => 'ro',
+ isa => 'Str',
+ default => sub { $_[1] },
+ -meta_attr_options => { isa => 'Str' },
+ };
+
+ has foo => (string => 'FOO');
+}
+
+{
+ package Foo;
+ use Moose;
+ with 'Foo::Role';
+}
+
+my $foo = Foo->new;
+is($foo->foo, 'FOO', "expanded properly");
+dies_ok { $foo->foo('sldkfj') } "expanded properly";
+
+{
+ package Bar::Role;
+ use Moose::Role;
+ use MooseX::Attribute::Shorthand my_lazy_build => {
+ lazy => 1,
+ builder => sub { "_build_$_[0]" },
+ predicate => sub {
+ my $name = shift;
+ my $private = $name =~ s/^_//;
+ $private ? "_has_$name" : "has_$name";
+ },
+ clearer => sub {
+ my $name = shift;
+ my $private = $name =~ s/^_//;
+ $private ? "_clear_$name" : "clear_$name";
+ },
+ };
+
+ has public => (
+ is => 'ro',
+ isa => 'Str',
+ my_lazy_build => 1,
+ );
+
+ sub _build_public { 'PUBLIC' }
+
+ has _private => (
+ is => 'ro',
+ isa => 'Str',
+ my_lazy_build => 1,
+ );
+
+ sub _build__private { 'PRIVATE' }
+}
+
+{
+ package Bar;
+ use Moose;
+ with 'Bar::Role';
+}
+
+my $bar = Bar->new;
+can_ok($bar, $_) for qw(has_public clear_public _has_private _clear_private);
+ok(!$bar->can($_), "Bar can't $_") for qw(has__private clear__private);
+
+ok(!$bar->has_public, "doesn't have a value yet");
+is($bar->public, 'PUBLIC', "gets a lazy value");
+ok($bar->has_public, "has a value now");
+$bar->clear_public;
+ok(!$bar->has_public, "doesn't have a value again");
+dies_ok { $bar->public('sldkfj') } "other options aren't overwritten";
+
+ok(!$bar->_has_private, "doesn't have a value yet");
+is($bar->_private, 'PRIVATE', "gets a lazy value");
+ok($bar->_has_private, "has a value now");
+$bar->_clear_private;
+ok(!$bar->_has_private, "doesn't have a value again");
+dies_ok { $bar->_private('sldkfj') } "other options aren't overwritten";
+
+done_testing;