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