From: Dave Rolsky Date: Thu, 22 Jan 2009 22:35:16 +0000 (+0000) Subject: yes, an explicit metaclass overrides a MetaRole declared attribute role, and that... X-Git-Tag: 0.65~6 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0764bffa5b77ea95fc7cf8c04ea37fc7a6d6e47d;p=gitmo%2FMoose.git yes, an explicit metaclass overrides a MetaRole declared attribute role, and that is expected behavior (metaclass is explicitly non-cooperative, traits cooperates) --- diff --git a/t/600_todo_tests/006_attr_metaclass_overrides_metarole.t b/t/600_todo_tests/006_attr_metaclass_overrides_metarole.t deleted file mode 100755 index 0b1654d..0000000 --- a/t/600_todo_tests/006_attr_metaclass_overrides_metarole.t +++ /dev/null @@ -1,105 +0,0 @@ -#!/usr/bin/perl -use strict; -use warnings; - -BEGIN { - # attribute metaclass for specifying with 'has' - package Foo::Meta::Attribute; - use Moose; - extends 'Moose::Meta::Attribute'; - - around _process_options => sub { - my $orig = shift; - my ($class, $name, $opts) = @_; - my $default = delete $opts->{default}; - $opts->{default} = sub { $default->() . "1" }; - $class->$orig($name, $opts); - }; - - # trait for specifying with has - package Foo::Meta::Trait; - use Moose::Role; - - around _process_options => sub { - my $orig = shift; - my ($class, $name, $opts) = @_; - my $default = delete $opts->{default}; - $opts->{default} = sub { $default->() . "2" }; - $class->$orig($name, $opts); - }; - - # attribute metaclass role for specifying with MetaRole - package Foo::Meta::Role::Attribute; - use Moose::Role; - - around _process_options => sub { - my $orig = shift; - my ($class, $name, $opts) = @_; - my $default = delete $opts->{default}; - $opts->{default} = sub { "3" . $default->() }; - $class->$orig($name, $opts); - }; - - package Foose; - use Moose (); - use Moose::Exporter; - use Moose::Util::MetaRole; - - Moose::Exporter->setup_import_methods(also => ['Moose']); - - sub init_meta { - shift; - my %options = @_; - Moose->init_meta(%options); - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => $options{for_class}, - attribute_metaclass_roles => ['Foo::Meta::Role::Attribute'], - ); - return $options{for_class}->meta; - } -} - -# class that uses both -{ - package Foo; - BEGIN { Foose->import } - - has bar => ( - is => 'ro', - isa => 'Str', - lazy => 1, - default => sub { 'BAR' }, - ); - - has baz => ( - metaclass => 'Foo::Meta::Attribute', - is => 'ro', - isa => 'Str', - lazy => 1, - default => sub { 'BAZ' }, - ); - - has quux => ( - traits => ['Foo::Meta::Trait'], - is => 'ro', - isa => 'Str', - lazy => 1, - default => sub { 'QUUX' }, - ); -} - -use Test::More tests => 8; -my $foo = Foo->new; -is($foo->bar, '3BAR', 'Attribute meta-role applied by exporter'); -ok($foo->meta->get_attribute('bar')->meta->does_role('Foo::Meta::Role::Attribute'), 'normal attribute does the meta-role'); - -TODO: { - local $TODO = 'metaclass on attribute currently overrides attr metarole'; - is($foo->baz, '3BAZ1', 'Attribute meta role from exporter + metaclass on attribute'); - ok($foo->meta->get_attribute('baz')->meta->does_role('Foo::Meta::Role::Attribute'), 'attribute using metaclass does the meta-role'); -}; -ok($foo->meta->get_attribute('baz')->isa('Foo::Meta::Attribute'), 'attribute using a metaclass isa the metaclass'); - -is($foo->quux, '3QUUX2', 'Attribute meta-role + trait'); -ok($foo->meta->get_attribute('quux')->meta->does_role('Foo::Meta::Role::Attribute'), 'attribute using a trait does the meta-role'); -ok($foo->meta->get_attribute('quux')->meta->does_role('Foo::Meta::Trait'), 'attribute using a trait does the trait');