remove trailing whitespace
[gitmo/Moose.git] / t / 020_attributes / 017_attribute_traits_n_meta.t
CommitLineData
2de7e794 1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
7ff56534 6use Test::More tests => 7;
2de7e794 7use Test::Exception;
8use Test::Moose;
9
7ff56534 10
2de7e794 11
12{
13 package My::Meta::Attribute::DefaultReadOnly;
14 use Moose;
d03bd989 15
2de7e794 16 extends 'Moose::Meta::Attribute';
d03bd989 17
2de7e794 18 around 'new' => sub {
19 my $next = shift;
20 my ($self, $name, %options) = @_;
d03bd989 21 $options{is} = 'ro'
2de7e794 22 unless exists $options{is};
23 $next->($self, $name, %options);
d03bd989 24 };
2de7e794 25}
26
27{
28 package My::Attribute::Trait;
29 use Moose::Role;
d03bd989 30
2de7e794 31 has 'alias_to' => (is => 'ro', isa => 'Str');
d03bd989 32
2de7e794 33 after 'install_accessors' => sub {
34 my $self = shift;
35 $self->associated_class->add_method(
d03bd989 36 $self->alias_to,
2de7e794 37 $self->get_read_method_ref
38 );
39 };
40}
41
42{
43 package My::Class;
44 use Moose;
d03bd989 45
2de7e794 46 has 'bar' => (
47 metaclass => 'My::Meta::Attribute::DefaultReadOnly',
48 traits => [qw/My::Attribute::Trait/],
49 isa => 'Int',
50 alias_to => 'baz',
51 );
52}
53
54my $c = My::Class->new(bar => 100);
55isa_ok($c, 'My::Class');
56
57is($c->bar, 100, '... got the right value for bar');
58
59can_ok($c, 'baz');
60is($c->baz, 100, '... got the right value for baz');
61
62isa_ok($c->meta->get_attribute('bar'), 'My::Meta::Attribute::DefaultReadOnly');
63does_ok($c->meta->get_attribute('bar'), 'My::Attribute::Trait');
64is($c->meta->get_attribute('bar')->_is_metadata, 'ro', '... got the right metaclass customization');
65
66
67
68