From: Jesse Luehrs Date: Fri, 26 Mar 2010 00:04:12 +0000 (-0500) Subject: add a couple of todo tests X-Git-Tag: 1.01~2 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6d6d232717e627fc07f3a90863579798d6bb55e5;p=gitmo%2FMoose.git add a couple of todo tests --- diff --git a/t/600_todo_tests/006_required_role_accessors.t b/t/600_todo_tests/006_required_role_accessors.t new file mode 100644 index 0000000..fed49f8 --- /dev/null +++ b/t/600_todo_tests/006_required_role_accessors.t @@ -0,0 +1,58 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Exception; + +{ + package Foo::API; + use Moose::Role; + + requires 'foo'; +} + +{ + package Foo; + use Moose::Role; + + has foo => (is => 'ro'); + + with 'Foo::API'; +} + +{ + package Foo::Class; + use Moose; + { our $TODO; local $TODO = "role accessors don't satisfy other role requires"; + ::lives_ok { with 'Foo' } 'requirements are satisfied properly'; + } +} + +{ + package Bar; + use Moose::Role; + + requires 'baz'; + + has bar => (is => 'ro'); +} + +{ + package Baz; + use Moose::Role; + + requires 'bar'; + + has baz => (is => 'ro'); +} + +{ + package BarBaz; + use Moose; + + { our $TODO; local $TODO = "role accessors don't satisfy other role requires"; + ::lives_ok { with qw(Bar Baz) } 'requirements are satisfied properly'; + } +} + +done_testing; diff --git a/t/600_todo_tests/007_metaclass_compat.t b/t/600_todo_tests/007_metaclass_compat.t new file mode 100644 index 0000000..dfee8d2 --- /dev/null +++ b/t/600_todo_tests/007_metaclass_compat.t @@ -0,0 +1,55 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Exception; + +our $called = 0; +{ + package Foo::Trait::Constructor; + use Moose::Role; + + around _generate_BUILDALL => sub { + my $orig = shift; + my $self = shift; + return $self->$orig(@_) . '$::called++;'; + } +} + +{ + package Foo; + use Moose; + Moose::Util::MetaRole::apply_metaroles( + for => __PACKAGE__, + class_metaroles => { + constructor => ['Foo::Trait::Constructor'], + } + ); +} + +Foo->new; +is($called, 0, "no calls before inlining"); +Foo->meta->make_immutable; + +Foo->new; +is($called, 1, "inlined constructor has trait modifications"); + +ok(Foo->meta->constructor_class->meta->does_role('Foo::Trait::Constructor'), + "class has correct constructor traits"); + +{ + package Foo::Sub; + use Moose; + extends 'Foo'; +} + +{ local $TODO = "metaclass compatibility fixing doesn't notice things unless the class or instance metaclass change"; +Foo::Sub->new; +is($called, 2, "subclass inherits constructor traits"); + +ok(Foo::Sub->meta->constructor_class->meta->can('does_role') +&& Foo::Sub->meta->constructor_class->meta->does_role('Foo::Trait::Constructor'), + "subclass inherits constructor traits"); +} + +done_testing;