From: Jesse Luehrs <doy@tozt.net>
Date: Sat, 17 Jan 2009 01:43:52 +0000 (+0000)
Subject: add a todo test for using Moose::Util::MetaRole with attributes that specify their... 
X-Git-Tag: 0.65~21
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fdacb0dde24cd539d4cac87c18e968431dde56cf;p=gitmo%2FMoose.git

add a todo test for using Moose::Util::MetaRole with attributes that specify their own metaclass
---

diff --git a/t/600_todo_tests/006_attr_metaclass_overrides_metarole.t b/t/600_todo_tests/006_attr_metaclass_overrides_metarole.t
new file mode 100755
index 0000000..0b1654d
--- /dev/null
+++ b/t/600_todo_tests/006_attr_metaclass_overrides_metarole.t
@@ -0,0 +1,105 @@
+#!/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');