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

autarch at code2.0beta.co.uk autarch at code2.0beta.co.uk
Thu Jan 22 22:35:17 GMT 2009


Author: autarch
Date: 2009-01-22 14:35:16 -0800 (Thu, 22 Jan 2009)
New Revision: 7368

Removed:
   Moose/trunk/t/600_todo_tests/006_attr_metaclass_overrides_metarole.t
Log:
yes, an explicit metaclass overrides a MetaRole declared attribute role, and that is expected behavior (metaclass is explicitly non-cooperative, traits cooperates)

Deleted: Moose/trunk/t/600_todo_tests/006_attr_metaclass_overrides_metarole.t
===================================================================
--- Moose/trunk/t/600_todo_tests/006_attr_metaclass_overrides_metarole.t	2009-01-22 22:25:36 UTC (rev 7367)
+++ Moose/trunk/t/600_todo_tests/006_attr_metaclass_overrides_metarole.t	2009-01-22 22:35:16 UTC (rev 7368)
@@ -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');




More information about the Moose-commits mailing list