t/600_todo_tests/006_attr_metaclass_overrides_metarole.t

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4
   5 BEGIN {
   6     # attribute metaclass for specifying with 'has'
   7     package Foo::Meta::Attribute;
   8     use Moose;
   9     extends 'Moose::Meta::Attribute';
  10
  11     around _process_options => sub {
  12         my $orig = shift;
  13         my ($class, $name, $opts) = @_;
  14         my $default = delete $opts->{default};
  15         $opts->{default} = sub { $default->() . "1" };
  16         $class->$orig($name, $opts);
  17     };
  18
  19     # trait for specifying with has
  20     package Foo::Meta::Trait;
  21     use Moose::Role;
  22
  23     around _process_options => sub {
  24         my $orig = shift;
  25         my ($class, $name, $opts) = @_;
  26         my $default = delete $opts->{default};
  27         $opts->{default} = sub { $default->() . "2" };
  28         $class->$orig($name, $opts);
  29     };
  30
  31     # attribute metaclass role for specifying with MetaRole
  32     package Foo::Meta::Role::Attribute;
  33     use Moose::Role;
  34
  35     around _process_options => sub {
  36         my $orig = shift;
  37         my ($class, $name, $opts) = @_;
  38         my $default = delete $opts->{default};
  39         $opts->{default} = sub { "3" . $default->() };
  40         $class->$orig($name, $opts);
  41     };
  42
  43     package Foose;
  44     use Moose ();
  45     use Moose::Exporter;
  46     use Moose::Util::MetaRole;
  47
  48     Moose::Exporter->setup_import_methods(also => ['Moose']);
  49
  50     sub init_meta {
  51         shift;
  52         my %options = @_;
  53         Moose->init_meta(%options);
  54         Moose::Util::MetaRole::apply_metaclass_roles(
  55             for_class                 => $options{for_class},
  56             attribute_metaclass_roles => ['Foo::Meta::Role::Attribute'],
  57         );
  58         return $options{for_class}->meta;
  59     }
  60 }
  61
  62 # class that uses both
  63 {
  64     package Foo;
  65     BEGIN { Foose->import }
  66
  67     has bar => (
  68         is  => 'ro',
  69         isa => 'Str',
  70         lazy => 1,
  71         default => sub { 'BAR' },
  72     );
  73
  74     has baz => (
  75         metaclass => 'Foo::Meta::Attribute',
  76         is  => 'ro',
  77         isa => 'Str',
  78         lazy => 1,
  79         default => sub { 'BAZ' },
  80     );
  81
  82     has quux => (
  83         traits => ['Foo::Meta::Trait'],
  84         is  => 'ro',
  85         isa => 'Str',
  86         lazy => 1,
  87         default => sub { 'QUUX' },
  88     );
  89 }
  90
  91 use Test::More tests => 8;
  92 my $foo = Foo->new;
  93 is($foo->bar, '3BAR', 'Attribute meta-role applied by exporter');
  94 ok($foo->meta->get_attribute('bar')->meta->does_role('Foo::Meta::Role::Attribute'), 'normal attribute does the meta-role');
  95
  96 TODO: {
  97     local $TODO = 'metaclass on attribute currently overrides attr metarole';
  98     is($foo->baz, '3BAZ1', 'Attribute meta role from exporter + metaclass on attribute');
  99     ok($foo->meta->get_attribute('baz')->meta->does_role('Foo::Meta::Role::Attribute'), 'attribute using metaclass does the meta-role');
 100 };
 101 ok($foo->meta->get_attribute('baz')->isa('Foo::Meta::Attribute'), 'attribute using a metaclass isa the metaclass');
 102
 103 is($foo->quux, '3QUUX2', 'Attribute meta-role + trait');
 104 ok($foo->meta->get_attribute('quux')->meta->does_role('Foo::Meta::Role::Attribute'), 'attribute using a trait does the meta-role');
 105 ok($foo->meta->get_attribute('quux')->meta->does_role('Foo::Meta::Trait'), 'attribute using a trait does the trait');