sub clone_and_inherit_options {
my ($self, %options) = @_;
- # you can change default, required, coerce, documentation and lazy
+ # you can change default, required, coerce, documentation, lazy, handles, builder, metaclass and traits
my %actual_options;
- foreach my $legal_option (qw(default coerce required documentation lazy handles builder)) {
+ foreach my $legal_option (qw(default coerce required documentation lazy handles builder metaclass traits)) {
if (exists $options{$legal_option}) {
$actual_options{$legal_option} = $options{$legal_option};
delete $options{$legal_option};
use strict;
use warnings;
-use Test::More tests => 83;
+use Test::More tests => 85;
use Test::Exception;
BEGIN {
::lives_ok {
has '+one_last_one' => (isa => 'Value');
} '... now can extend an attribute with a non-subtype';
-
+
+ ::lives_ok {
+ has '+foo' => ( metaclass => 'DoNotSerialize' );
+ } 'Can add metaclass attribute option';
+
+ ::lives_ok {
+ has '+foo' => ( traits => [ 'DoNotSerialize' ] );
+ } 'Can add traits attribute option';
+
::lives_ok {
has '+bling' => (handles => ['hello']);
} '... we can add the handles attribute option';
use strict;
use warnings;
-use Test::More tests => 6;
+use Test::More tests => 13;
use Test::Exception;
use Test::Moose;
}
{
+ package My::Other::Attribute::Trait;
+ use Moose::Role;
+
+ my $method = sub {
+ 42;
+ };
+
+ after 'install_accessors' => sub {
+ my $self = shift;
+ $self->associated_class->add_method(
+ 'additional_method',
+ $method
+ );
+ };
+
+ package Moose::Meta::Attribute::Custom::Trait::Other;
+ sub register_implementation { 'My::Other::Attribute::Trait' }
+}
+
+{
package My::Class;
use Moose;
);
}
+{
+ package My::Derived::Class;
+ use Moose;
+
+ extends 'My::Class';
+
+ has '+bar' => (
+ traits => [qw/Other/],
+ );
+}
+
my $c = My::Class->new(bar => 100);
isa_ok($c, 'My::Class');
is($c->bar, 100, '... got the right value for bar');
-can_ok($c, 'baz');
+can_ok($c, 'baz') and
is($c->baz, 100, '... got the right value for baz');
does_ok($c->meta->get_attribute('bar'), 'My::Attribute::Trait');
+
+my $quux = My::Derived::Class->new(bar => 1000);
+
+is($quux->bar, 1000, '... got the right value for bar');
+
+can_ok($quux, 'baz');
+is($quux->baz, 1000, '... got the right value for baz');
+ok($quux->meta->get_attribute('bar')->does('My::Attribute::Trait'));
+
+TODO: {
+ local $TODO = 'These do not pass - bug?';
+ SKIP: {
+ skip 'no additional_method, so cannot test its value', 1 if !can_ok($quux, 'additional_method');
+ is($quux->additional_method, 42, '... got the right value for additional_method');
+ }
+ ok($quux->meta->get_attribute('bar')->does('My::Other::Attribute::Trait'));
+}