[Moose-commits] r7314 - Moose/trunk/t/600_todo_tests

[doy at code2.0beta.co.uk]

Author: doy
Date: 2009-01-16 17:43:52 -0800 (Fri, 16 Jan 2009)
New Revision: 7314

Added:
   Moose/trunk/t/600_todo_tests/006_attr_metaclass_overrides_metarole.t
Log:
add a todo test for using Moose::Util::MetaRole with attributes that specify their own metaclass



Added: Moose/trunk/t/600_todo_tests/006_attr_metaclass_overrides_metarole.t
===================================================================
--- Moose/trunk/t/600_todo_tests/006_attr_metaclass_overrides_metarole.t	                        (rev 0)
+++ Moose/trunk/t/600_todo_tests/006_attr_metaclass_overrides_metarole.t	2009-01-17 01:43:52 UTC (rev 7314)
@@ -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');


Property changes on: Moose/trunk/t/600_todo_tests/006_attr_metaclass_overrides_metarole.t
___________________________________________________________________
Name: svn:executable
   + *