From e487cbac42aac4f6bded38ffc91b66e1d1d1ddc6 Mon Sep 17 00:00:00 2001
From: Jesse Luehrs <doy@tozt.net>
Date: Thu, 24 Jun 2010 13:41:55 -0500
Subject: make it work for role attributes

---
 dist.ini                          |  1 +
 lib/MooseX/Attribute/Shorthand.pm |  3 ++
 t/004-roles.t                     | 89 +++++++++++++++++++++++++++++++++++++++
 3 files changed, 93 insertions(+)
 create mode 100644 t/004-roles.t

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;
-- 
cgit v1.2.3-54-g00ecf