From: Fuji, Goro Date: Fri, 24 Sep 2010 05:07:40 +0000 (+0900) Subject: Regenerate test files X-Git-Tag: 0.71~10 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=fde8e43f95fe996fbc2a778aa259feeb04552171 Regenerate test files --- diff --git a/author/import-moose-test.pl b/author/import-moose-test.pl index a0ad424..559b8d3 100644 --- a/author/import-moose-test.pl +++ b/author/import-moose-test.pl @@ -8,12 +8,9 @@ use autodie; my($moose_dir, $result) = @ARGV; unless(defined $moose_dir and -d "$moose_dir/t") { - die "Usage: $0 Moose-dir result-dir\n"; -} -$result //= 'Moose-test'; -if(-e $result) { - die "'$result' exists, stopped"; + die "Usage: $0 Moose-dir [result-dir]\n"; } +$result //= 't'; my @tests; sub wanted { @@ -75,6 +72,8 @@ sub copy_as_mouse { while(<$in>) { if($. == 2) { + say $out "# This is automatically generated by $0."; + say $out "# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!"; say $out 'use t::lib::MooseCompat;'; } s/\b Class::MOP::([a-z_]+) \b/Mouse::Util::$1/xmsg; diff --git a/t-failing/010_basics/002_require_superclasses.t b/t-failing/010_basics/002_require_superclasses.t new file mode 100644 index 0000000..b08c95d --- /dev/null +++ b/t-failing/010_basics/002_require_superclasses.t @@ -0,0 +1,73 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use lib 't/lib', 'lib'; + +use Test::More; +$TODO = q{Mouse is not yet completed}; +use Test::Exception; + + +{ + + package Bar; + use Mouse; + + ::lives_ok { extends 'Foo' } 'loaded Foo superclass correctly'; +} + +{ + + package Baz; + use Mouse; + + ::lives_ok { extends 'Bar' } 'loaded (inline) Bar superclass correctly'; +} + +{ + + package Foo::Bar; + use Mouse; + + ::lives_ok { extends 'Foo', 'Bar' } + 'loaded Foo and (inline) Bar superclass correctly'; +} + +{ + + package Bling; + use Mouse; + + ::throws_ok { extends 'No::Class' } + qr{Can't locate No/Class\.pm in \@INC}, + 'correct error when superclass could not be found'; +} + +{ + package Affe; + our $VERSION = 23; +} + +{ + package Tiger; + use Mouse; + + ::lives_ok { extends 'Foo', Affe => { -version => 13 } } + 'extends with version requirement'; +} + +{ + package Birne; + use Mouse; + + ::throws_ok { extends 'Foo', Affe => { -version => 42 } } + qr/Affe version 42 required--this is only version 23/, + 'extends with unsatisfied version requirement'; +} + +done_testing; diff --git a/t/010_basics/failing/012_rebless.t b/t-failing/010_basics/012_rebless.t similarity index 83% rename from t/010_basics/failing/012_rebless.t rename to t-failing/010_basics/012_rebless.t index e8c6722..dd946f0 100644 --- a/t/010_basics/failing/012_rebless.t +++ b/t-failing/010_basics/012_rebless.t @@ -1,9 +1,13 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 11; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; use Scalar::Util 'blessed'; @@ -62,10 +66,10 @@ lives_ok { $foo->type_constrained(10.5) } "Num type constraint for now.."; # try to rebless, except it will fail due to Child's stricter type constraint throws_ok { Child->meta->rebless_instance($foo) } -qr/^Attribute \(type_constrained\) does not pass the type constraint because\: Validation failed for 'Int' failed with value 10\.5/, +qr/^Attribute \(type_constrained\) does not pass the type constraint because\: Validation failed for 'Int' with value 10\.5/, '... this failed cause of type check'; throws_ok { Child->meta->rebless_instance($bar) } -qr/^Attribute \(type_constrained\) does not pass the type constraint because\: Validation failed for 'Int' failed with value 5\.5/, +qr/^Attribute \(type_constrained\) does not pass the type constraint because\: Validation failed for 'Int' with value 5\.5/, '... this failed cause of type check';; $foo->type_constrained(10); @@ -81,5 +85,7 @@ is($foo->lazy_classname, 'Parent', "lazy attribute was already initialized"); is($bar->lazy_classname, 'Child', "lazy attribute just now initialized"); throws_ok { $foo->type_constrained(10.5) } -qr/^Attribute \(type_constrained\) does not pass the type constraint because\: Validation failed for 'Int' failed with value 10\.5/, +qr/^Attribute \(type_constrained\) does not pass the type constraint because\: Validation failed for 'Int' with value 10\.5/, '... this failed cause of type check'; + +done_testing; diff --git a/t/020_attributes/005_attribute_does.t b/t-failing/020_attributes/005_attribute_does.t similarity index 80% rename from t/020_attributes/005_attribute_does.t rename to t-failing/020_attributes/005_attribute_does.t index 267f98d..e41a4d1 100644 --- a/t/020_attributes/005_attribute_does.t +++ b/t-failing/020_attributes/005_attribute_does.t @@ -1,13 +1,16 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 9; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; - { package Foo::Role; use Mouse::Role; @@ -19,27 +22,26 @@ use Test::Exception; has 'bar' => (is => 'rw', does => 'Bar::Role'); has 'baz' => ( is => 'rw', - does => 'Bar::Role' + does => role_type('Bar::Role') ); + package Foo::Class; + use Mouse; + + with 'Foo::Role'; + package Bar::Role; use Mouse::Role; # if isa and does appear together, then see if Class->does(Role) # if it does work... then the does() check is actually not needed # since the isa() check will imply the does() check - has 'foo' => (is => 'rw', isa => 'Foo::Class'); - - package Foo::Class; - use Mouse; - - with 'Foo::Role'; + has 'foo' => (is => 'rw', isa => 'Foo::Class', does => 'Foo::Role'); package Bar::Class; use Mouse; with 'Bar::Role'; - } my $foo = Foo::Class->new; @@ -74,13 +76,12 @@ lives_ok { { package Baz::Class; - use Test::More; use Mouse; # if isa and does appear together, then see if Class->does(Role) # if it does not,.. we have a conflict... so we die loudly ::dies_ok { - has 'foo' => (is => 'rw', isa => 'Foo::Class', does => 'Bar::Class'); + has 'foo' => (isa => 'Foo::Class', does => 'Bar::Class'); } '... cannot have a does() which is not done by the isa()'; } @@ -92,15 +93,13 @@ lives_ok { sub bling { 'Bling::bling' } package Bling::Bling; - use Test::More; use Mouse; # if isa and does appear together, then see if Class->does(Role) # if it does not,.. we have a conflict... so we die loudly ::dies_ok { - has 'foo' => (is => 'rw', isa => 'Bling', does => 'Bar::Class'); + has 'foo' => (isa => 'Bling', does => 'Bar::Class'); } '... cannot have a isa() which is cannot does()'; } - - +done_testing; diff --git a/t/020_attributes/failing/010_attribute_delegation.t b/t-failing/020_attributes/010_attribute_delegation.t similarity index 90% rename from t/020_attributes/failing/010_attribute_delegation.t rename to t-failing/020_attributes/010_attribute_delegation.t index 9dd746a..b111bc8 100644 --- a/t/020_attributes/failing/010_attribute_delegation.t +++ b/t-failing/020_attributes/010_attribute_delegation.t @@ -1,13 +1,16 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 92; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; - # ------------------------------------------------------------------- # HASH handles # ------------------------------------------------------------------- @@ -44,7 +47,7 @@ ok($bar->foo, '... we have something in bar->foo'); isa_ok($bar->foo, 'Foo'); my $meth = Bar->meta->get_method('foo_bar'); -isa_ok($meth, 'Mouse::Meta::Method::Delegation'); +isa_ok($meth, 'Mouse::Meta::Method'); is($meth->associated_attribute->name, 'foo', 'associated_attribute->name for this method is foo'); @@ -244,6 +247,15 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop'); handles => 'Foo::Bar', ); + package Foo::OtherThing; + use Mouse; + use Mouse::Util::TypeConstraints; + + has 'other_thing' => ( + is => 'rw', + isa => 'Foo::Baz', + handles => Mouse::Util::TypeConstraints::find_type_constraint('Foo::Bar'), + ); } { @@ -260,6 +272,19 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop'); is($foo->thing->baz, 'Foo::Baz::BAZ', '... got the right value'); } +{ + my $foo = Foo::OtherThing->new(other_thing => Foo::Baz->new); + isa_ok($foo, 'Foo::OtherThing'); + isa_ok($foo->other_thing, 'Foo::Baz'); + + ok($foo->meta->has_method('foo'), '... we have the method we expect'); + ok($foo->meta->has_method('bar'), '... we have the method we expect'); + ok(!$foo->meta->has_method('baz'), '... we dont have the method we expect'); + + is($foo->foo, 'Foo::Baz::FOO', '... got the right value'); + is($foo->bar, 'Foo::Baz::BAR', '... got the right value'); + is($foo->other_thing->baz, 'Foo::Baz::BAZ', '... got the right value'); +} # ------------------------------------------------------------------- # AUTOLOAD & handles # ------------------------------------------------------------------- @@ -434,3 +459,5 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop'); my $k = Bar->new(foo => "Foo"); lives_ok { $k->foo_baz } "but not for class name"; } + +done_testing; diff --git a/t/020_attributes/011_more_attr_delegation.t b/t-failing/020_attributes/011_more_attr_delegation.t similarity index 78% rename from t/020_attributes/011_more_attr_delegation.t rename to t-failing/020_attributes/011_more_attr_delegation.t index 75d6fa1..c588848 100644 --- a/t/020_attributes/011_more_attr_delegation.t +++ b/t-failing/020_attributes/011_more_attr_delegation.t @@ -1,9 +1,13 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 39; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; =pod @@ -76,9 +80,24 @@ do not fail at compile time. sub child_g_method_1 { "g1" } + package ChildH; + use Mouse; + + sub child_h_method_1 { "h1" } + sub parent_method_1 { "child_parent_1" } + + package ChildI; + use Mouse; + + sub child_i_method_1 { "i1" } + sub parent_method_1 { "child_parent_1" } + package Parent; use Mouse; + sub parent_method_1 { "parent_1" } + ::can_ok('Parent', 'parent_method_1'); + ::dies_ok { has child_a => ( is => "ro", @@ -167,6 +186,30 @@ do not fail at compile time. ); } "can delegate to object even without explicit reader"; + ::can_ok('Parent', 'parent_method_1'); + ::dies_ok { + has child_h => ( + isa => "ChildH", + is => "ro", + default => sub { ChildH->new }, + handles => sub { map { $_, $_ } $_[1]->get_all_method_names }, + ); + } "Can't override exisiting class method in delegate"; + ::can_ok('Parent', 'parent_method_1'); + + ::lives_ok { + has child_i => ( + isa => "ChildI", + is => "ro", + default => sub { ChildI->new }, + handles => sub { + map { $_, $_ } grep { !/^parent_method_1|meta$/ } + $_[1]->get_all_method_names; + }, + ); + } "Test handles code ref for skipping predefined methods"; + + sub parent_method { "p" } } @@ -179,8 +222,10 @@ isa_ok( $p->child_c, "ChildC" ); isa_ok( $p->child_d, "ChildD" ); isa_ok( $p->child_e, "ChildE" ); isa_ok( $p->child_f, "ChildF" ); +isa_ok( $p->child_i, "ChildI" ); ok(!$p->can('child_g'), '... no child_g accessor defined'); +ok(!$p->can('child_h'), '... no child_h accessor defined'); is( $p->parent_method, "p", "parent method" ); @@ -215,3 +260,8 @@ is( $p->child_e_method_2, "e2", "delegate to non moose class (child_e_method_2)" can_ok( $p, "child_g_method_1" ); is( $p->child_g_method_1, "g1", "delegate to moose class without reader (child_g_method_1)" ); + +can_ok( $p, "child_i_method_1" ); +is( $p->parent_method_1, "parent_1", "delegate doesn't override existing method" ); + +done_testing; diff --git a/t/020_attributes/failing/021_method_generation_rules.t b/t-failing/020_attributes/021_method_generation_rules.t similarity index 88% rename from t/020_attributes/failing/021_method_generation_rules.t rename to t-failing/020_attributes/021_method_generation_rules.t index 2169780..b275d1c 100644 --- a/t/020_attributes/failing/021_method_generation_rules.t +++ b/t-failing/020_attributes/021_method_generation_rules.t @@ -1,13 +1,16 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 17; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; - =pod is => rw, writer => _foo # turns into (reader => foo, writer => _foo) @@ -61,3 +64,4 @@ is($obj->_foo(), 1, "$class->foo is reader"); dies_ok { make_class('ro', 'accessor', "Test::Class::AccessorRO"); } "Cant define attr with ro + accessor"; +done_testing; diff --git a/t/020_attributes/failing/023_attribute_names.t b/t-failing/020_attributes/023_attribute_names.t similarity index 81% rename from t/020_attributes/failing/023_attribute_names.t rename to t-failing/020_attributes/023_attribute_names.t index f98d556..6eb442d 100644 --- a/t/020_attributes/failing/023_attribute_names.t +++ b/t-failing/020_attributes/023_attribute_names.t @@ -1,8 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 8; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; my $exception_regex = qr/You must provide a name for the attribute/; @@ -56,3 +60,4 @@ my $exception_regex = qr/You must provide a name for the attribute/; } 'has 0; works now'; } +done_testing; diff --git a/t/020_attributes/failing/028_no_slot_access.t b/t-failing/020_attributes/028_no_slot_access.t similarity index 78% rename from t/020_attributes/failing/028_no_slot_access.t rename to t-failing/020_attributes/028_no_slot_access.t index 12ff7b0..668f71b 100644 --- a/t/020_attributes/failing/028_no_slot_access.t +++ b/t-failing/020_attributes/028_no_slot_access.t @@ -1,4 +1,7 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; @@ -12,7 +15,7 @@ use warnings; } { - package MouseX::SomeAwesomeDBFields; + package MooseX::SomeAwesomeDBFields; # implementation of methods not called in the example deliberately # omitted @@ -60,12 +63,13 @@ use warnings; use Mouse; use Mouse::Util::MetaRole; - use Test::More tests => 3; + use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => __PACKAGE__, - instance_metaclass_roles => ['MouseX::SomeAwesomeDBFields'] + Mouse::Util::MetaRole::apply_metaroles( + for => __PACKAGE__, + class_metaroles => { instance => ['MooseX::SomeAwesomeDBFields'] }, ); lives_ok { @@ -87,4 +91,6 @@ use warnings; lives_ok { __PACKAGE__->meta->make_immutable; } "Inling constructor does not use inline_slot_access"; + + done_testing; } diff --git a/t-failing/020_attributes/033_accessor_inlining.t b/t-failing/020_attributes/033_accessor_inlining.t new file mode 100644 index 0000000..0d664c7 --- /dev/null +++ b/t-failing/020_attributes/033_accessor_inlining.t @@ -0,0 +1,37 @@ +#!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use strict; +use warnings; +use Test::More; +$TODO = q{Mouse is not yet completed}; + +my $called; +{ + package Foo::Meta::Instance; + use Mouse::Role; + + sub is_inlinable { 0 } + + after get_slot_value => sub { $called++ }; +} + +{ + package Foo; + use Mouse; + Mouse::Util::MetaRole::apply_metaroles( + for => __PACKAGE__, + class_metaroles => { + instance => ['Foo::Meta::Instance'], + }, + ); + + has foo => (is => 'ro'); +} + +my $foo = Foo->new(foo => 1); +is($foo->foo, 1, "got the right value"); +is($called, 1, "reader was called"); + +done_testing; diff --git a/t/030_roles/001_meta_role.t b/t-failing/030_roles/001_meta_role.t similarity index 76% rename from t/030_roles/001_meta_role.t rename to t-failing/030_roles/001_meta_role.t index 8b642c3..b93903f 100644 --- a/t/030_roles/001_meta_role.t +++ b/t-failing/030_roles/001_meta_role.t @@ -1,15 +1,17 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 26; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; -use Test::Mouse; use Mouse::Meta::Role; -use lib 't/lib'; -use MooseCompat; +use Mouse::Util::TypeConstraints (); { package FooRole; @@ -21,7 +23,7 @@ use MooseCompat; my $foo_role = Mouse::Meta::Role->initialize('FooRole'); isa_ok($foo_role, 'Mouse::Meta::Role'); -#isa_ok($foo_role, 'Class::MOP::Module'); +isa_ok($foo_role, 'Mouse::Meta::Module'); is($foo_role->name, 'FooRole', '... got the right name of FooRole'); is($foo_role->version, '0.01', '... got the right version of FooRole'); @@ -58,13 +60,16 @@ is_deeply( ok($foo_role->has_attribute('bar'), '... FooRole does have the bar attribute'); -{ - local $TODO = 'Mouse does not support role attributes'; - is_deeply( - join('|', %{$foo_role->get_attribute('bar')}), - join('|', %{+{ is => 'rw', isa => 'Foo' }}), - '... got the correct description of the bar attribute'); -} +my $bar = $foo_role->get_attribute('bar'); +is_deeply( $bar->original_options, { is => 'rw', isa => 'Foo' }, + 'original options for bar attribute' ); +my $bar_for_class = $bar->attribute_for_class('Mouse::Meta::Attribute'); +is( + $bar_for_class->type_constraint, + Mouse::Util::TypeConstraints::class_type('Foo'), + 'bar has a Foo class type' +); + lives_ok { $foo_role->add_attribute('baz' => (is => 'ro')); } '... added the baz attribute okay'; @@ -76,10 +81,9 @@ is_deeply( ok($foo_role->has_attribute('baz'), '... FooRole does have the baz attribute'); -is_deeply( - $foo_role->get_attribute('baz')->{is}, - 'ro', - '... got the correct description of the baz attribute'); +my $baz = $foo_role->get_attribute('baz'); +is_deeply( $baz->original_options, { is => 'ro' }, + 'original options for baz attribute' ); lives_ok { $foo_role->remove_attribute('bar'); @@ -109,3 +113,5 @@ is_deeply( [ $foo_role->get_method_modifier_list('before') ], [ 'boo' ], '... got the right list of before method modifiers'); + +done_testing; diff --git a/t/030_roles/003_apply_role.t b/t-failing/030_roles/003_apply_role.t similarity index 90% rename from t/030_roles/003_apply_role.t rename to t-failing/030_roles/003_apply_role.t index 2910669..2ff8a0d 100644 --- a/t/030_roles/003_apply_role.t +++ b/t-failing/030_roles/003_apply_role.t @@ -1,15 +1,21 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; { package FooRole; use Mouse::Role; + our $VERSION = 23; + has 'bar' => ( is => 'rw', isa => 'FooClass' ); has 'baz' => ( is => 'ro' ); @@ -43,7 +49,13 @@ use Test::Exception; use Mouse; extends 'BarClass'; - with 'FooRole'; + + ::throws_ok { with 'FooRole' => { -version => 42 } } + qr/FooRole version 42 required--this is only version 23/, + 'applying role with unsatisfied version requirement'; + + ::lives_ok { with 'FooRole' => { -version => 13 } } + 'applying role with satisfied version requirement'; sub blau {'FooClass::blau'} # << the role wraps this ... diff --git a/t/030_roles/failing/006_role_exclusion.t b/t-failing/030_roles/006_role_exclusion.t similarity index 94% rename from t/030_roles/failing/006_role_exclusion.t rename to t-failing/030_roles/006_role_exclusion.t index e60a768..32eed57 100644 --- a/t/030_roles/failing/006_role_exclusion.t +++ b/t-failing/030_roles/006_role_exclusion.t @@ -1,9 +1,13 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 22; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; =pod @@ -121,3 +125,4 @@ ok(My::Test4->meta->does_role('Molecule::Organic'), '... My::Test4 meat does_rol ok(My::Test4->meta->excludes_role('Molecule::Inorganic'), '... My::Test4 meta excludes Molecule::Organic'); ok(!My::Test4->does('Molecule::Inorganic'), '... My::Test4 does Molecule::Inorganic'); +done_testing; diff --git a/t/030_roles/failing/007_roles_and_req_method_edge_cases.t b/t-failing/030_roles/007_roles_and_req_method_edge_cases.t similarity index 95% rename from t/030_roles/failing/007_roles_and_req_method_edge_cases.t rename to t-failing/030_roles/007_roles_and_req_method_edge_cases.t index 5e45d89..b9fbeb6 100644 --- a/t/030_roles/failing/007_roles_and_req_method_edge_cases.t +++ b/t-failing/030_roles/007_roles_and_req_method_edge_cases.t @@ -1,9 +1,13 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 15; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; =pod @@ -136,7 +140,7 @@ method modifier. sub foo { 'Class::ProvideFoo::foo' } before 'foo' => sub { 'Class::ProvideFoo::foo:before' }; - ::isa_ok(__PACKAGE__->meta->get_method('foo'), 'Class::MOP::Method::Wrapped'); + ::isa_ok(__PACKAGE__->meta->get_method('foo'), 'Mouse::Meta::Method'); ::is(__PACKAGE__->meta->get_method('foo')->get_original_method->package_name, __PACKAGE__, '... but the original method is from our package'); @@ -275,3 +279,5 @@ method modifier. with 'Bar2::Role'; } 'required method exists in superclass as non-modifier, so we live'; } + +done_testing; diff --git a/t/030_roles/failing/011_overriding.t b/t-failing/030_roles/011_overriding.t similarity index 96% rename from t/030_roles/failing/011_overriding.t rename to t-failing/030_roles/011_overriding.t index 89e1668..6007e25 100644 --- a/t/030_roles/failing/011_overriding.t +++ b/t-failing/030_roles/011_overriding.t @@ -1,13 +1,16 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 39; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; - { # test no conflicts here package Role::A; @@ -227,3 +230,4 @@ ok(Role::I->meta->requires_method('foo'), '... Role::I still have the &foo requi } +done_testing; diff --git a/t/030_roles/failing/012_method_exclusion_in_composition.t b/t-failing/030_roles/012_method_exclusion_in_composition.t similarity index 92% rename from t/030_roles/failing/012_method_exclusion_in_composition.t rename to t-failing/030_roles/012_method_exclusion_in_composition.t index d852b17..1bc3b98 100644 --- a/t/030_roles/failing/012_method_exclusion_in_composition.t +++ b/t-failing/030_roles/012_method_exclusion_in_composition.t @@ -1,13 +1,16 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 19; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; - { package My::Role; use Mouse::Role; @@ -111,5 +114,4 @@ ok(!My::Foo::Role->meta->requires_method('foo'), '... and the &foo method is not ok(!My::Foo::Role::Other->meta->has_method('foo'), "we dont have a foo method"); ok(My::Foo::Role::Other->meta->requires_method('foo'), '... and the &foo method is required'); - - +done_testing; diff --git a/t/030_roles/013_method_aliasing_in_composition.t b/t-failing/030_roles/013_method_aliasing_in_composition.t similarity index 92% rename from t/030_roles/013_method_aliasing_in_composition.t rename to t-failing/030_roles/013_method_aliasing_in_composition.t index 9cb7b9b..1934d64 100644 --- a/t/030_roles/013_method_aliasing_in_composition.t +++ b/t-failing/030_roles/013_method_aliasing_in_composition.t @@ -1,13 +1,16 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 46; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; - { package My::Role; use Mouse::Role; @@ -58,11 +61,8 @@ ok(My::Class->meta->has_method($_), "we have a $_ method") for qw(foo baz bar ro } ok(My::OtherRole->meta->has_method($_), "we have a $_ method") for qw(foo baz role_bar); -{ -local $TODO = 'auto requires resolution is not supported'; ok(My::OtherRole->meta->requires_method('bar'), '... and the &bar method is required'); ok(!My::OtherRole->meta->requires_method('role_bar'), '... and the &role_bar method is not required'); -} { package My::AliasingRole; @@ -104,11 +104,12 @@ ok(!My::AliasingRole->meta->requires_method('bar'), '... and the &bar method is package My::Foo::Class::Broken; use Mouse; - ::dies_ok { + ::throws_ok { with 'Foo::Role' => { -alias => { 'foo' => 'foo_foo' }, -excludes => 'foo' }, 'Bar::Role' => { -alias => { 'foo' => 'foo_foo' }, -excludes => 'foo' }, 'Baz::Role'; - } '... composed our roles correctly'; + } qr/Due to a method name conflict in roles 'Bar::Role' and 'Foo::Role', the method 'foo_foo' must be implemented or excluded by 'My::Foo::Class::Broken'/, + '... composed our roles correctly'; } { @@ -137,11 +138,8 @@ ok(!My::Foo::Role->meta->requires_method('foo'), '... and the &foo method is not { package My::Foo::Role::Other; - use Test::More; # for $TODO use Mouse::Role; - local $TODO = 'not supported'; - ::lives_ok { with 'Foo::Role' => { -alias => { 'foo' => 'foo_foo' }, -excludes => 'foo' }, 'Bar::Role' => { -alias => { 'foo' => 'foo_foo' }, -excludes => 'foo' }, @@ -150,10 +148,8 @@ ok(!My::Foo::Role->meta->requires_method('foo'), '... and the &foo method is not } ok(!My::Foo::Role::Other->meta->has_method('foo_foo'), "we dont have a foo_foo method"); -{ -local $TODO = 'auto requires resolution is not supported'; ok(My::Foo::Role::Other->meta->requires_method('foo_foo'), '... and the &foo method is required'); -} + { package My::Foo::AliasOnly; use Mouse; @@ -219,3 +215,5 @@ ok(My::Foo::AliasOnly->meta->has_method('foo_foo'), '.. and the aliased foo_foo for qw( x1 foo_x1 ); ok( ! $baz->has_method('y1'), 'Role::Baz has no y1 method' ); } + +done_testing; diff --git a/t/030_roles/017_extending_role_attrs.t b/t-failing/030_roles/017_extending_role_attrs.t similarity index 89% rename from t/030_roles/017_extending_role_attrs.t rename to t-failing/030_roles/017_extending_role_attrs.t index 79514c0..c672ae9 100644 --- a/t/030_roles/017_extending_role_attrs.t +++ b/t-failing/030_roles/017_extending_role_attrs.t @@ -1,13 +1,16 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 27; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; - =pod This basically just makes sure that using +name @@ -173,3 +176,16 @@ is_deeply($quux->quux, ["hi"], "... still has the old ArrayRef value"); } "or add new types to the union"; } +{ + package Role::With::PlusAttr; + use Mouse::Role; + + with 'Foo::Role'; + + ::throws_ok { + has '+bar' => ( is => 'ro' ); + } qr/has '\+attr' is not supported in roles/, + "Test has '+attr' in roles explodes"; +} + +done_testing; diff --git a/t/030_roles/failing/020_role_composite.t b/t-failing/030_roles/020_role_composite.t similarity index 84% rename from t/030_roles/failing/020_role_composite.t rename to t-failing/030_roles/020_role_composite.t index 0f00eb0..78335e8 100644 --- a/t/030_roles/failing/020_role_composite.t +++ b/t-failing/030_roles/020_role_composite.t @@ -1,12 +1,16 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 14; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; -#use Mouse::Meta::Role::Application::RoleSummation; +use Mouse::Meta::Role::Application; use Mouse::Meta::Role::Composite; { @@ -49,7 +53,7 @@ use Mouse::Meta::Role::Composite; ); lives_ok { - Mouse::Meta::Role::Application::RoleSummation->new->apply($c); + Mouse::Meta::Role::Application->new->apply($c); } '... this composed okay'; ##... now nest 'em @@ -78,3 +82,5 @@ use Mouse::Meta::Role::Composite; ); } } + +done_testing; diff --git a/t/030_roles/failing/021_role_composite_exclusion.t b/t-failing/030_roles/021_role_composite_exclusion.t similarity index 81% rename from t/030_roles/failing/021_role_composite_exclusion.t rename to t-failing/030_roles/021_role_composite_exclusion.t index c8b6f6b..e58faf3 100644 --- a/t/030_roles/failing/021_role_composite_exclusion.t +++ b/t-failing/030_roles/021_role_composite_exclusion.t @@ -1,12 +1,16 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 12; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; -#use Mouse::Meta::Role::Application::RoleSummation; +use Mouse::Meta::Role::Application; use Mouse::Meta::Role::Composite; { @@ -34,7 +38,7 @@ ok(Role::DoesExcludesFoo->meta->excludes_role('Role::Foo'), '... got the right e # test simple exclusion dies_ok { - Mouse::Meta::Role::Application::RoleSummation->new->apply( + Mouse::Meta::Role::Application->new->apply( Mouse::Meta::Role::Composite->new( roles => [ Role::Foo->meta, @@ -57,7 +61,7 @@ dies_ok { is($c->name, 'Role::Foo|Role::Bar', '... got the composite role name'); lives_ok { - Mouse::Meta::Role::Application::RoleSummation->new->apply($c); + Mouse::Meta::Role::Application->new->apply($c); } '... this lives as expected'; } @@ -74,7 +78,7 @@ dies_ok { is($c->name, 'Role::Bar|Role::ExcludesFoo', '... got the composite role name'); lives_ok { - Mouse::Meta::Role::Application::RoleSummation->new->apply($c); + Mouse::Meta::Role::Application->new->apply($c); } '... this lives as expected'; is_deeply([$c->get_excluded_roles_list], ['Role::Foo'], '... has excluded roles'); @@ -83,7 +87,7 @@ dies_ok { # test conflict with an "inherited" exclusion dies_ok { - Mouse::Meta::Role::Application::RoleSummation->new->apply( + Mouse::Meta::Role::Application->new->apply( Mouse::Meta::Role::Composite->new( roles => [ Role::Foo->meta, @@ -96,7 +100,7 @@ dies_ok { # test conflict with an "inherited" exclusion of an "inherited" role dies_ok { - Mouse::Meta::Role::Application::RoleSummation->new->apply( + Mouse::Meta::Role::Application->new->apply( Mouse::Meta::Role::Composite->new( roles => [ Role::DoesFoo->meta, @@ -106,4 +110,4 @@ dies_ok { ); } '... this fails as expected'; - +done_testing; diff --git a/t/030_roles/failing/022_role_composition_req_methods.t b/t-failing/030_roles/022_role_composition_req_methods.t similarity index 84% rename from t/030_roles/failing/022_role_composition_req_methods.t rename to t-failing/030_roles/022_role_composition_req_methods.t index 3843153..1ca09ff 100644 --- a/t/030_roles/failing/022_role_composition_req_methods.t +++ b/t-failing/030_roles/022_role_composition_req_methods.t @@ -1,12 +1,16 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 16; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; -use Mouse::Meta::Role::Application::RoleSummation; +use Mouse::Meta::Role::Application; use Mouse::Meta::Role::Composite; { @@ -40,7 +44,7 @@ use Mouse::Meta::Role::Composite; is($c->name, 'Role::Foo|Role::Bar', '... got the composite role name'); lives_ok { - Mouse::Meta::Role::Application::RoleSummation->new->apply($c); + Mouse::Meta::Role::Application->new->apply($c); } '... this succeeds as expected'; is_deeply( @@ -63,7 +67,7 @@ use Mouse::Meta::Role::Composite; is($c->name, 'Role::Foo|Role::ProvidesFoo', '... got the composite role name'); lives_ok { - Mouse::Meta::Role::Application::RoleSummation->new->apply($c); + Mouse::Meta::Role::Application->new->apply($c); } '... this succeeds as expected'; is_deeply( @@ -87,7 +91,7 @@ use Mouse::Meta::Role::Composite; is($c->name, 'Role::Foo|Role::ProvidesFoo|Role::Bar', '... got the composite role name'); lives_ok { - Mouse::Meta::Role::Application::RoleSummation->new->apply($c); + Mouse::Meta::Role::Application->new->apply($c); } '... this succeeds as expected'; is_deeply( @@ -112,7 +116,7 @@ use Mouse::Meta::Role::Composite; is($c->name, 'Role::Foo|Role::ProvidesFoo|Role::ProvidesBar|Role::Bar', '... got the composite role name'); lives_ok { - Mouse::Meta::Role::Application::RoleSummation->new->apply($c); + Mouse::Meta::Role::Application->new->apply($c); } '... this succeeds as expected'; is_deeply( @@ -122,4 +126,4 @@ use Mouse::Meta::Role::Composite; ); } - +done_testing; diff --git a/t/030_roles/failing/023_role_composition_attributes.t b/t-failing/030_roles/023_role_composition_attributes.t similarity index 80% rename from t/030_roles/failing/023_role_composition_attributes.t rename to t-failing/030_roles/023_role_composition_attributes.t index 9785463..4c04817 100644 --- a/t/030_roles/failing/023_role_composition_attributes.t +++ b/t-failing/030_roles/023_role_composition_attributes.t @@ -1,12 +1,16 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 7; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; -use Mouse::Meta::Role::Application::RoleSummation; +use Mouse::Meta::Role::Application; use Mouse::Meta::Role::Composite; { @@ -44,7 +48,7 @@ use Mouse::Meta::Role::Composite; is($c->name, 'Role::Foo|Role::Bar', '... got the composite role name'); lives_ok { - Mouse::Meta::Role::Application::RoleSummation->new->apply($c); + Mouse::Meta::Role::Application->new->apply($c); } '... this succeeds as expected'; is_deeply( @@ -56,7 +60,7 @@ use Mouse::Meta::Role::Composite; # test simple conflict dies_ok { - Mouse::Meta::Role::Application::RoleSummation->new->apply( + Mouse::Meta::Role::Application->new->apply( Mouse::Meta::Role::Composite->new( roles => [ Role::Foo->meta, @@ -68,7 +72,7 @@ dies_ok { # test complex conflict dies_ok { - Mouse::Meta::Role::Application::RoleSummation->new->apply( + Mouse::Meta::Role::Application->new->apply( Mouse::Meta::Role::Composite->new( roles => [ Role::Foo->meta, @@ -82,7 +86,7 @@ dies_ok { # test simple conflict dies_ok { - Mouse::Meta::Role::Application::RoleSummation->new->apply( + Mouse::Meta::Role::Application->new->apply( Mouse::Meta::Role::Composite->new( roles => [ Role::Foo->meta, @@ -92,3 +96,4 @@ dies_ok { ); } '... this fails as expected'; +done_testing; diff --git a/t/030_roles/failing/024_role_composition_methods.t b/t-failing/030_roles/024_role_composition_methods.t similarity index 86% rename from t/030_roles/failing/024_role_composition_methods.t rename to t-failing/030_roles/024_role_composition_methods.t index 2f60d0d..c214bae 100644 --- a/t/030_roles/failing/024_role_composition_methods.t +++ b/t-failing/030_roles/024_role_composition_methods.t @@ -1,12 +1,16 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 19; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; -use Mouse::Meta::Role::Application::RoleSummation; +use Mouse::Meta::Role::Application; use Mouse::Meta::Role::Composite; { @@ -50,7 +54,7 @@ use Mouse::Meta::Role::Composite; is($c->name, 'Role::Foo|Role::Bar', '... got the composite role name'); lives_ok { - Mouse::Meta::Role::Application::RoleSummation->new->apply($c); + Mouse::Meta::Role::Application->new->apply($c); } '... this succeeds as expected'; is_deeply( @@ -73,7 +77,7 @@ use Mouse::Meta::Role::Composite; is($c->name, 'Role::Foo|Role::FooConflict', '... got the composite role name'); lives_ok { - Mouse::Meta::Role::Application::RoleSummation->new->apply($c); + Mouse::Meta::Role::Application->new->apply($c); } '... this succeeds as expected'; is_deeply( @@ -104,7 +108,7 @@ use Mouse::Meta::Role::Composite; is($c->name, 'Role::Foo|Role::Bar|Role::FooConflict|Role::BarConflict', '... got the composite role name'); lives_ok { - Mouse::Meta::Role::Application::RoleSummation->new->apply($c); + Mouse::Meta::Role::Application->new->apply($c); } '... this succeeds as expected'; is_deeply( @@ -133,7 +137,7 @@ use Mouse::Meta::Role::Composite; is($c->name, 'Role::Foo|Role::AnotherFooConflict', '... got the composite role name'); lives_ok { - Mouse::Meta::Role::Application::RoleSummation->new->apply($c); + Mouse::Meta::Role::Application->new->apply($c); } '... this succeeds as expected'; is_deeply( @@ -149,3 +153,4 @@ use Mouse::Meta::Role::Composite; ); } +done_testing; diff --git a/t/030_roles/failing/025_role_composition_override.t b/t-failing/030_roles/025_role_composition_override.t similarity index 81% rename from t/030_roles/failing/025_role_composition_override.t rename to t-failing/030_roles/025_role_composition_override.t index 4396ce5..3b1483a 100644 --- a/t/030_roles/failing/025_role_composition_override.t +++ b/t-failing/030_roles/025_role_composition_override.t @@ -1,12 +1,16 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 8; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; -use Mouse::Meta::Role::Application::RoleSummation; +use Mouse::Meta::Role::Application; use Mouse::Meta::Role::Composite; { @@ -49,7 +53,7 @@ use Mouse::Meta::Role::Composite; is($c->name, 'Role::Foo|Role::Bar', '... got the composite role name'); lives_ok { - Mouse::Meta::Role::Application::RoleSummation->new->apply($c); + Mouse::Meta::Role::Application->new->apply($c); } '... this lives ok'; is_deeply( @@ -61,7 +65,7 @@ use Mouse::Meta::Role::Composite; # test simple overrides w/ conflicts dies_ok { - Mouse::Meta::Role::Application::RoleSummation->new->apply( + Mouse::Meta::Role::Application->new->apply( Mouse::Meta::Role::Composite->new( roles => [ Role::Foo->meta, @@ -73,7 +77,7 @@ dies_ok { # test simple overrides w/ conflicts dies_ok { - Mouse::Meta::Role::Application::RoleSummation->new->apply( + Mouse::Meta::Role::Application->new->apply( Mouse::Meta::Role::Composite->new( roles => [ Role::Foo->meta, @@ -86,7 +90,7 @@ dies_ok { # test simple overrides w/ conflicts dies_ok { - Mouse::Meta::Role::Application::RoleSummation->new->apply( + Mouse::Meta::Role::Application->new->apply( Mouse::Meta::Role::Composite->new( roles => [ Role::Foo->meta, @@ -100,7 +104,7 @@ dies_ok { # test simple overrides w/ conflicts dies_ok { - Mouse::Meta::Role::Application::RoleSummation->new->apply( + Mouse::Meta::Role::Application->new->apply( Mouse::Meta::Role::Composite->new( roles => [ Role::Foo->meta, @@ -110,3 +114,5 @@ dies_ok { ) ); } '... this fails as expected'; + +done_testing; diff --git a/t/030_roles/failing/026_role_composition_method_mods.t b/t-failing/030_roles/026_role_composition_method_mods.t similarity index 84% rename from t/030_roles/failing/026_role_composition_method_mods.t rename to t-failing/030_roles/026_role_composition_method_mods.t index 909c1ff..94eee11 100644 --- a/t/030_roles/failing/026_role_composition_method_mods.t +++ b/t-failing/030_roles/026_role_composition_method_mods.t @@ -1,12 +1,16 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 7; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; -use Mouse::Meta::Role::Application::RoleSummation; +use Mouse::Meta::Role::Application; use Mouse::Meta::Role::Composite; { @@ -63,7 +67,7 @@ use Mouse::Meta::Role::Composite; is($c->name, 'Role::Foo|Role::Bar', '... got the composite role name'); lives_ok { - Mouse::Meta::Role::Application::RoleSummation->new->apply($c); + Mouse::Meta::Role::Application->new->apply($c); } '... this succeeds as expected'; is_deeply( @@ -84,3 +88,5 @@ use Mouse::Meta::Role::Composite; '... got the right list of methods' ); } + +done_testing; diff --git a/t/030_roles/failing/032_roles_and_method_cloning.t b/t-failing/030_roles/032_roles_and_method_cloning.t similarity index 84% rename from t/030_roles/failing/032_roles_and_method_cloning.t rename to t-failing/030_roles/032_roles_and_method_cloning.t index 2b4e615..07194de 100644 --- a/t/030_roles/failing/032_roles_and_method_cloning.t +++ b/t-failing/030_roles/032_roles_and_method_cloning.t @@ -1,9 +1,13 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 17; +use Test::More; +$TODO = q{Mouse is not yet completed}; { @@ -73,9 +77,7 @@ use Test::More tests => 17; isnt( ClassA->foo, "ClassB::foo", "ClassA::foo is not confused with ClassB::foo"); -{ - local $TODO = - "multiply-consumed roles' subs take on their most recently used name"; - is( ClassB->foo, 'ClassB::foo', 'ClassB::foo knows its name' ); - is( ClassA->foo, 'ClassA::foo', 'ClassA::foo knows its name' ); -} +is( ClassB->foo, 'Role::Foo::foo', 'ClassB::foo knows its name' ); +is( ClassA->foo, 'Role::Foo::foo', 'ClassA::foo knows its name' ); + +done_testing; diff --git a/t-failing/030_roles/038_new_meta_role.t b/t-failing/030_roles/038_new_meta_role.t new file mode 100644 index 0000000..c78d830 --- /dev/null +++ b/t-failing/030_roles/038_new_meta_role.t @@ -0,0 +1,23 @@ +#!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use strict; +use warnings; +use Test::More; +$TODO = q{Mouse is not yet completed}; + +do { + package My::Meta::Role; + use Mouse; + BEGIN { extends 'Mouse::Meta::Role' }; +}; + +do { + package My::Role; + use Mouse::Role -metaclass => 'My::Meta::Role'; +}; + +is(My::Role->meta->meta->name, 'My::Meta::Role'); + +done_testing; diff --git a/t/030_roles/failing/039_application_toclass.t b/t-failing/030_roles/039_application_toclass.t similarity index 79% rename from t/030_roles/failing/039_application_toclass.t rename to t-failing/030_roles/039_application_toclass.t index e6984fc..99889eb 100644 --- a/t/030_roles/failing/039_application_toclass.t +++ b/t-failing/030_roles/039_application_toclass.t @@ -1,7 +1,11 @@ #!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 24; +use Test::More; +$TODO = q{Mouse is not yet completed}; do { package Role::Foo; @@ -48,10 +52,10 @@ my $excludes = $excludes[0]; my $aliases = $aliases[0]; my $overrides = $overrides[0]; -isa_ok($basic, 'Mouse::Meta::Role::Application::ToClass'); -isa_ok($excludes, 'Mouse::Meta::Role::Application::ToClass'); -isa_ok($aliases, 'Mouse::Meta::Role::Application::ToClass'); -isa_ok($overrides, 'Mouse::Meta::Role::Application::ToClass'); +isa_ok($basic, 'Mouse::Meta::Role::Application'); +isa_ok($excludes, 'Mouse::Meta::Role::Application'); +isa_ok($aliases, 'Mouse::Meta::Role::Application'); +isa_ok($overrides, 'Mouse::Meta::Role::Application'); is($basic->role, Role::Foo->meta); is($excludes->role, Role::Foo->meta); @@ -73,3 +77,4 @@ is_deeply($excludes->get_method_exclusions, ['foo']); is_deeply($aliases->get_method_exclusions, []); is_deeply($overrides->get_method_exclusions, []); +done_testing; diff --git a/t/030_roles/failing/040_role_for_combination.t b/t-failing/030_roles/040_role_for_combination.t similarity index 81% rename from t/030_roles/failing/040_role_for_combination.t rename to t-failing/030_roles/040_role_for_combination.t index 3e7642d..757e4f1 100644 --- a/t/030_roles/failing/040_role_for_combination.t +++ b/t-failing/030_roles/040_role_for_combination.t @@ -1,7 +1,11 @@ #!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 3; +use Test::More; +$TODO = q{Mouse is not yet completed}; my $OPTS; do { @@ -43,3 +47,4 @@ is(My::Class->foo, 'My::Singleton::Role', 'role_for_combination applied'); is(My::Class->bar, 'My::Usual::Role', 'collateral role'); is_deeply($OPTS, { number => 1 }); +done_testing; diff --git a/t-failing/030_roles/043_conflict_many_methods.t b/t-failing/030_roles/043_conflict_many_methods.t new file mode 100644 index 0000000..27589d9 --- /dev/null +++ b/t-failing/030_roles/043_conflict_many_methods.t @@ -0,0 +1,52 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use strict; +use warnings; + +use Test::More; +$TODO = q{Mouse is not yet completed}; +use Test::Exception; + +{ + package Bomb; + use Mouse::Role; + + sub fuse { } + sub explode { } + + package Spouse; + use Mouse::Role; + + sub fuse { } + sub explode { } + + package Caninish; + use Mouse::Role; + + sub bark { } + + package Treeve; + use Mouse::Role; + + sub bark { } +} + +{ + package PracticalJoke; + use Mouse; + + ::throws_ok { + with 'Bomb', 'Spouse'; + } qr/Due to method name conflicts in roles 'Bomb' and 'Spouse', the methods 'explode' and 'fuse' must be implemented or excluded by 'PracticalJoke'/; + + ::throws_ok { + with ( + 'Bomb', 'Spouse', + 'Caninish', 'Treeve', + ); + } qr/Due to a method name conflict in roles 'Caninish' and 'Treeve', the method 'bark' must be implemented or excluded by 'PracticalJoke'/; +} + +done_testing; diff --git a/t-failing/030_roles/044_role_attrs.t b/t-failing/030_roles/044_role_attrs.t new file mode 100644 index 0000000..06687fe --- /dev/null +++ b/t-failing/030_roles/044_role_attrs.t @@ -0,0 +1,58 @@ +use strict; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use warnings; + +use Test::More; +$TODO = q{Mouse is not yet completed}; +use Test::Exception; + +use Mouse (); +use Mouse::Meta::Role; +use Mouse::Util; + +my $role1 = Mouse::Meta::Role->initialize('Foo'); +$role1->add_attribute( foo => ( is => 'ro' ) ); + +ok( $role1->has_attribute('foo'), 'Foo role has a foo attribute' ); + +my $foo_attr = $role1->get_attribute('foo'); +is( + $foo_attr->associated_role->name, 'Foo', + 'associated_role for foo attr is Foo role' +); + +isa_ok( + $foo_attr->attribute_for_class('Mouse::Meta::Attribute'), + 'Mouse::Meta::Attribute', + 'attribute returned by ->attribute_for_class' +); + +my $role2 = Mouse::Meta::Role->initialize('Bar'); +$role1->apply($role2); + +ok( $role2->has_attribute('foo'), 'Bar role has a foo attribute' ); + +is( + $foo_attr->associated_role->name, 'Foo', + 'associated_role for foo attr is still Foo role' +); + +isa_ok( + $foo_attr->attribute_for_class('Mouse::Meta::Attribute'), + 'Mouse::Meta::Attribute', + 'attribute returned by ->attribute_for_class' +); + +my $role3 = Mouse::Meta::Role->initialize('Baz'); +my $combined = Mouse::Meta::Role->combine( [ $role1->name ], [ $role3->name ] ); + +ok( $combined->has_attribute('foo'), 'combined role has a foo attribute' ); + +is( + $foo_attr->associated_role->name, 'Foo', + 'associated_role for foo attr is still Foo role' +); + +done_testing; diff --git a/t-failing/030_roles/046_role_consumers.t b/t-failing/030_roles/046_role_consumers.t new file mode 100644 index 0000000..9f6509a --- /dev/null +++ b/t-failing/030_roles/046_role_consumers.t @@ -0,0 +1,58 @@ +use strict; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use warnings; + +use Test::More; +$TODO = q{Mouse is not yet completed}; + +{ + package Foo::Role; + use Mouse::Role; +} + +{ + package Bar::Role; + use Mouse::Role; +} + +{ + package Foo; + use Mouse; + with 'Foo::Role'; +} + +{ + package Bar; + use Mouse; + extends 'Foo'; + with 'Bar::Role'; +} + +{ + package FooBar; + use Mouse; + with 'Foo::Role', 'Bar::Role'; +} + +{ + package Foo::Role::User; + use Mouse::Role; + with 'Foo::Role'; +} + +{ + package Foo::User; + use Mouse; + with 'Foo::Role::User'; +} + +is_deeply([sort Foo::Role->meta->consumers], + ['Bar', 'Foo', 'Foo::Role::User', 'Foo::User', 'FooBar']); +is_deeply([sort Bar::Role->meta->consumers], + ['Bar', 'FooBar']); +is_deeply([sort Foo::Role::User->meta->consumers], + ['Foo::User']); + +done_testing; diff --git a/t-failing/030_roles/047_role_attribute_conflict.t b/t-failing/030_roles/047_role_attribute_conflict.t new file mode 100644 index 0000000..a641ef4 --- /dev/null +++ b/t-failing/030_roles/047_role_attribute_conflict.t @@ -0,0 +1,33 @@ +use strict; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use warnings; + +use Test::More; +$TODO = q{Mouse is not yet completed}; +use Test::Exception; + +{ + package My::Role1; + use Mouse::Role; + + has foo => ( + is => 'ro', + ); + +} + +{ + package My::Role2; + use Mouse::Role; + + has foo => ( + is => 'ro', + ); + + ::throws_ok { with 'My::Role1' } qr/attribute conflict.+My::Role2.+foo/, + 'attribute conflict when composing one role into another'; +} + +done_testing; diff --git a/t/040_type_constraints/failing/001_util_type_constraints.t b/t-failing/040_type_constraints/001_util_type_constraints.t similarity index 95% rename from t/040_type_constraints/failing/001_util_type_constraints.t rename to t-failing/040_type_constraints/001_util_type_constraints.t index a928ff5..9c53dab 100644 --- a/t/040_type_constraints/failing/001_util_type_constraints.t +++ b/t-failing/040_type_constraints/001_util_type_constraints.t @@ -1,15 +1,17 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 85; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; use Scalar::Util (); -use lib 't/lib'; -use Test::Mouse; use Mouse::Util::TypeConstraints; @@ -106,7 +108,7 @@ ok(!$natural->has_message, '... it does not have a message'); ok(!defined($natural->validate(5)), '... validated successfully (no error)'); is($natural->validate(-5), - "Validation failed for 'Natural' failed with value -5", + "Validation failed for 'Natural' with value -5", '... validated unsuccessfully (got error)'); my $string = find_type_constraint('String'); @@ -196,6 +198,11 @@ throws_ok {$r->add_type_constraint(bless {}, 'SomeClass')} qr/not a valid type c # sugar was indistinguishable from calling directly. { + no warnings 'redefine'; + *Mouse::Deprecated::deprecated = sub { return }; +} + +{ my $type = type( 'Number2', sub { Scalar::Util::looks_like_number($_) } ); ok( $type->check(5), '... this is a Num' ); @@ -227,3 +234,4 @@ throws_ok {$r->add_type_constraint(bless {}, 'SomeClass')} qr/not a valid type c ok( ! $subtype->check('Foo'), '... this is not a Natural'); } +done_testing; diff --git a/t/040_type_constraints/004_util_find_type_constraint.t b/t-failing/040_type_constraints/004_util_find_type_constraint.t similarity index 73% rename from t/040_type_constraints/004_util_find_type_constraint.t rename to t-failing/040_type_constraints/004_util_find_type_constraint.t index 1a58e8c..7caf228 100644 --- a/t/040_type_constraints/004_util_find_type_constraint.t +++ b/t-failing/040_type_constraints/004_util_find_type_constraint.t @@ -1,9 +1,13 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 17; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; BEGIN { @@ -27,6 +31,7 @@ foreach my $type_name (qw( CodeRef RegexpRef Object + Role )) { is(find_type_constraint($type_name)->name, $type_name, @@ -35,3 +40,5 @@ foreach my $type_name (qw( # TODO: # add tests for is_subtype_of which confirm the hierarchy + +done_testing; diff --git a/t/040_type_constraints/005_util_type_coercion.t b/t-failing/040_type_constraints/005_util_type_coercion.t similarity index 90% rename from t/040_type_constraints/005_util_type_coercion.t rename to t-failing/040_type_constraints/005_util_type_coercion.t index b191095..d540102 100644 --- a/t/040_type_constraints/005_util_type_coercion.t +++ b/t-failing/040_type_constraints/005_util_type_coercion.t @@ -1,16 +1,17 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 8; # tests => 26; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; -use lib 't/lib'; -use MooseCompat; - BEGIN { - use_ok('Mouse::Util::TypeConstraints'); + use_ok('Mouse::Util::TypeConstraints'); } { @@ -51,12 +52,11 @@ lives_ok { => via { HTTPHeader->new(hash => $_[0]) }; } 'coercion of anonymous subtype succeeds'; -=pod - foreach my $coercion ( find_type_constraint('Header')->coercion, $anon_type->coercion ) { + isa_ok($coercion, 'Mouse::Meta::TypeCoercion'); { @@ -93,8 +93,6 @@ foreach my $coercion ( } } -=cut - subtype 'StrWithTrailingX' => as 'Str' => where { /X$/ }; @@ -106,3 +104,5 @@ coerce 'StrWithTrailingX' my $tc = find_type_constraint('StrWithTrailingX'); is($tc->coerce("foo"), "fooX", "coerce when needed"); is($tc->coerce("fooX"), "fooX", "do not coerce when unneeded"); + +done_testing; diff --git a/t/040_type_constraints/failing/008_union_types.t b/t-failing/040_type_constraints/008_union_types.t similarity index 63% rename from t/040_type_constraints/failing/008_union_types.t rename to t-failing/040_type_constraints/008_union_types.t index c0c9ce0..e05a5d5 100644 --- a/t/040_type_constraints/failing/008_union_types.t +++ b/t-failing/040_type_constraints/008_union_types.t @@ -1,9 +1,13 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 35; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; BEGIN { @@ -21,8 +25,8 @@ ok($Str->check('String'), '... Str can accept an String value'); ok(!$Undef->check('String'), '... Undef cannot accept an Str value'); ok($Undef->check(undef), '... Undef can accept an Undef value'); -my $Str_or_Undef = Mouse::Meta::TypeConstraint::Union->new(type_constraints => [$Str, $Undef]); -isa_ok($Str_or_Undef, 'Mouse::Meta::TypeConstraint::Union'); +my $Str_or_Undef = Mouse::Meta::TypeConstraint->new(type_constraints => [$Str, $Undef]); +isa_ok($Str_or_Undef, 'Mouse::Meta::TypeConstraint'); ok($Str_or_Undef->check(undef), '... (Str | Undef) can accept an Undef value'); ok($Str_or_Undef->check('String'), '... (Str | Undef) can accept a String value'); @@ -30,10 +34,14 @@ ok($Str_or_Undef->check('String'), '... (Str | Undef) can accept a String value' ok($Str_or_Undef->is_a_type_of($Str), "subtype of Str"); ok($Str_or_Undef->is_a_type_of($Undef), "subtype of Undef"); +cmp_ok($Str_or_Undef->find_type_for('String'), 'eq', 'Str', 'find_type_for Str'); +cmp_ok($Str_or_Undef->find_type_for(undef), 'eq', 'Undef', 'find_type_for Undef'); +ok(!defined($Str_or_Undef->find_type_for(sub { })), 'no find_type_for CodeRef'); + ok( !$Str_or_Undef->equals($Str), "not equal to Str" ); ok( $Str_or_Undef->equals($Str_or_Undef), "equal to self" ); -ok( $Str_or_Undef->equals(Mouse::Meta::TypeConstraint::Union->new(type_constraints => [ $Str, $Undef ])), "equal to clone" ); -ok( $Str_or_Undef->equals(Mouse::Meta::TypeConstraint::Union->new(type_constraints => [ $Undef, $Str ])), "equal to reversed clone" ); +ok( $Str_or_Undef->equals(Mouse::Meta::TypeConstraint->new(type_constraints => [ $Str, $Undef ])), "equal to clone" ); +ok( $Str_or_Undef->equals(Mouse::Meta::TypeConstraint->new(type_constraints => [ $Undef, $Str ])), "equal to reversed clone" ); ok( !$Str_or_Undef->is_a_type_of("ThisTypeDoesNotExist"), "not type of non existant type" ); ok( !$Str_or_Undef->is_subtype_of("ThisTypeDoesNotExist"), "not subtype of non existant type" ); @@ -51,8 +59,8 @@ ok(!$ArrayRef->check({}), '... ArrayRef cannot accept an {} value'); ok($HashRef->check({}), '... HashRef can accept an {} value'); ok(!$HashRef->check([]), '... HashRef cannot accept an [] value'); -my $HashOrArray = Mouse::Meta::TypeConstraint::Union->new(type_constraints => [$ArrayRef, $HashRef]); -isa_ok($HashOrArray, 'Mouse::Meta::TypeConstraint::Union'); +my $HashOrArray = Mouse::Meta::TypeConstraint->new(type_constraints => [$ArrayRef, $HashRef]); +isa_ok($HashOrArray, 'Mouse::Meta::TypeConstraint'); ok($HashOrArray->check([]), '... (ArrayRef | HashRef) can accept []'); ok($HashOrArray->check({}), '... (ArrayRef | HashRef) can accept {}'); @@ -67,14 +75,15 @@ ok(!defined($HashOrArray->validate([])), '... (ArrayRef | HashRef) can accept [] ok(!defined($HashOrArray->validate({})), '... (ArrayRef | HashRef) can accept {}'); like($HashOrArray->validate(\(my $var2)), -qr/Validation failed for \'ArrayRef\' failed with value SCALAR\(0x.+?\) and Validation failed for \'HashRef\' failed with value SCALAR\(0x.+?\) in \(ArrayRef\|HashRef\)/, +qr/Validation failed for \'ArrayRef\' with value SCALAR\(0x.+?\) and Validation failed for \'HashRef\' with value SCALAR\(0x.+?\) in \(ArrayRef\|HashRef\)/, '... (ArrayRef | HashRef) cannot accept scalar refs'); like($HashOrArray->validate(sub {}), -qr/Validation failed for \'ArrayRef\' failed with value CODE\(0x.+?\) and Validation failed for \'HashRef\' failed with value CODE\(0x.+?\) in \(ArrayRef\|HashRef\)/, +qr/Validation failed for \'ArrayRef\' with value CODE\(0x.+?\) and Validation failed for \'HashRef\' with value CODE\(0x.+?\) in \(ArrayRef\|HashRef\)/, '... (ArrayRef | HashRef) cannot accept code refs'); is($HashOrArray->validate(50), -'Validation failed for \'ArrayRef\' failed with value 50 and Validation failed for \'HashRef\' failed with value 50 in (ArrayRef|HashRef)', +'Validation failed for \'ArrayRef\' with value 50 and Validation failed for \'HashRef\' with value 50 in (ArrayRef|HashRef)', '... (ArrayRef | HashRef) cannot accept Numbers'); +done_testing; diff --git a/t/040_type_constraints/failing/012_container_type_coercion.t b/t-failing/040_type_constraints/012_container_type_coercion.t similarity index 74% rename from t/040_type_constraints/failing/012_container_type_coercion.t rename to t-failing/040_type_constraints/012_container_type_coercion.t index 798a448..b94c1ed 100644 --- a/t/040_type_constraints/failing/012_container_type_coercion.t +++ b/t-failing/040_type_constraints/012_container_type_coercion.t @@ -1,25 +1,30 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 9; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; BEGIN { use_ok('Mouse::Util::TypeConstraints'); + use_ok('Mouse::Meta::TypeConstraint'); } my $r = Mouse::Util::TypeConstraints->get_type_constraint_registry; # Array of Ints -my $array_of_ints = Mouse::Meta::TypeConstraint::Parameterized->new( +my $array_of_ints = Mouse::Meta::TypeConstraint->new( name => 'ArrayRef[Int]', parent => find_type_constraint('ArrayRef'), type_parameter => find_type_constraint('Int'), ); -isa_ok($array_of_ints, 'Mouse::Meta::TypeConstraint::Parameterized'); +isa_ok($array_of_ints, 'Mouse::Meta::TypeConstraint'); isa_ok($array_of_ints, 'Mouse::Meta::TypeConstraint'); $r->add_type_constraint($array_of_ints); @@ -28,12 +33,12 @@ is(find_type_constraint('ArrayRef[Int]'), $array_of_ints, '... found the type we # Hash of Ints -my $hash_of_ints = Mouse::Meta::TypeConstraint::Parameterized->new( +my $hash_of_ints = Mouse::Meta::TypeConstraint->new( name => 'HashRef[Int]', parent => find_type_constraint('HashRef'), type_parameter => find_type_constraint('Int'), ); -isa_ok($hash_of_ints, 'Mouse::Meta::TypeConstraint::Parameterized'); +isa_ok($hash_of_ints, 'Mouse::Meta::TypeConstraint'); isa_ok($hash_of_ints, 'Mouse::Meta::TypeConstraint'); $r->add_type_constraint($hash_of_ints); @@ -64,4 +69,4 @@ isa_ok($foo, 'Foo'); is_deeply([ sort @{$foo->bar} ], [ 1, 2, 3 ], '... our coercion worked!'); - +done_testing; diff --git a/t/040_type_constraints/failing/013_advanced_type_creation.t b/t-failing/040_type_constraints/013_advanced_type_creation.t similarity index 86% rename from t/040_type_constraints/failing/013_advanced_type_creation.t rename to t-failing/040_type_constraints/013_advanced_type_creation.t index 7610baa..10c908c 100644 --- a/t/040_type_constraints/failing/013_advanced_type_creation.t +++ b/t-failing/040_type_constraints/013_advanced_type_creation.t @@ -1,14 +1,18 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 33; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; BEGIN { use_ok('Mouse::Util::TypeConstraints'); - use_ok('Mouse::Meta::TypeConstraint::Parameterized'); + use_ok('Mouse::Meta::TypeConstraint'); } my $r = Mouse::Util::TypeConstraints->get_type_constraint_registry; @@ -18,7 +22,7 @@ my $r = Mouse::Util::TypeConstraints->get_type_constraint_registry; # Array of Ints or Strings my $array_of_ints_or_strings = Mouse::Util::TypeConstraints::create_parameterized_type_constraint('ArrayRef[Int|Str]'); -isa_ok($array_of_ints_or_strings, 'Mouse::Meta::TypeConstraint::Parameterized'); +isa_ok($array_of_ints_or_strings, 'Mouse::Meta::TypeConstraint'); ok($array_of_ints_or_strings->check([ 1, 'two', 3 ]), '... this passed the type check'); ok($array_of_ints_or_strings->check([ 1, 2, 3 ]), '... this passed the type check'); @@ -31,7 +35,7 @@ $r->add_type_constraint($array_of_ints_or_strings); # Array of Ints or HashRef my $array_of_ints_or_hash_ref = Mouse::Util::TypeConstraints::create_parameterized_type_constraint('ArrayRef[Int | HashRef]'); -isa_ok($array_of_ints_or_hash_ref, 'Mouse::Meta::TypeConstraint::Parameterized'); +isa_ok($array_of_ints_or_hash_ref, 'Mouse::Meta::TypeConstraint'); ok($array_of_ints_or_hash_ref->check([ 1, {}, 3 ]), '... this passed the type check'); ok($array_of_ints_or_hash_ref->check([ 1, 2, 3 ]), '... this passed the type check'); @@ -47,7 +51,7 @@ $r->add_type_constraint($array_of_ints_or_hash_ref); # we have, so we have to do it by hand - SL my $pure_insanity = Mouse::Util::TypeConstraints::create_type_constraint_union('ArrayRef[Int|Str] | ArrayRef[Int | HashRef]'); -isa_ok($pure_insanity, 'Mouse::Meta::TypeConstraint::Union'); +isa_ok($pure_insanity, 'Mouse::Meta::TypeConstraint'); ok($pure_insanity->check([ 1, {}, 3 ]), '... this passed the type check'); ok($pure_insanity->check([ 1, 'Str', 3 ]), '... this passed the type check'); @@ -60,7 +64,7 @@ ok(!$pure_insanity->check([ [], {}, 1 ]), '... this didnt pass the type check'); # Array of Ints my $array_of_ints = Mouse::Util::TypeConstraints::create_parameterized_type_constraint('ArrayRef[Int]'); -isa_ok($array_of_ints, 'Mouse::Meta::TypeConstraint::Parameterized'); +isa_ok($array_of_ints, 'Mouse::Meta::TypeConstraint'); isa_ok($array_of_ints, 'Mouse::Meta::TypeConstraint'); ok($array_of_ints->check([ 1, 2, 3, 4 ]), '... [ 1, 2, 3, 4 ] passed successfully'); @@ -74,7 +78,7 @@ ok(!$array_of_ints->check(sub { () }), '... sub { () } failed successfully'); # Array of Array of Ints my $array_of_array_of_ints = Mouse::Util::TypeConstraints::create_parameterized_type_constraint('ArrayRef[ArrayRef[Int]]'); -isa_ok($array_of_array_of_ints, 'Mouse::Meta::TypeConstraint::Parameterized'); +isa_ok($array_of_array_of_ints, 'Mouse::Meta::TypeConstraint'); isa_ok($array_of_array_of_ints, 'Mouse::Meta::TypeConstraint'); ok($array_of_array_of_ints->check( @@ -87,7 +91,7 @@ ok(!$array_of_array_of_ints->check( # Array of Array of Array of Ints my $array_of_array_of_array_of_ints = Mouse::Util::TypeConstraints::create_parameterized_type_constraint('ArrayRef[ArrayRef[ArrayRef[Int]]]'); -isa_ok($array_of_array_of_array_of_ints, 'Mouse::Meta::TypeConstraint::Parameterized'); +isa_ok($array_of_array_of_array_of_ints, 'Mouse::Meta::TypeConstraint'); isa_ok($array_of_array_of_array_of_ints, 'Mouse::Meta::TypeConstraint'); ok($array_of_array_of_array_of_ints->check( @@ -97,5 +101,4 @@ ok(!$array_of_array_of_array_of_ints->check( [[[ 1, 2, 3 ]], [[ qw/foo bar/ ]]] ), '... [[[ 1, 2, 3 ]], [[ qw/foo bar/ ]]] failed successfully'); - - +done_testing; diff --git a/t/040_type_constraints/failing/014_type_notation_parser.t b/t-failing/040_type_constraints/014_type_notation_parser.t similarity index 94% rename from t/040_type_constraints/failing/014_type_notation_parser.t rename to t-failing/040_type_constraints/014_type_notation_parser.t index b2821c1..3a75815 100644 --- a/t/040_type_constraints/failing/014_type_notation_parser.t +++ b/t-failing/040_type_constraints/014_type_notation_parser.t @@ -1,9 +1,13 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 41; +use Test::More; +$TODO = q{Mouse is not yet completed}; BEGIN { use_ok("Mouse::Util::TypeConstraints"); @@ -103,3 +107,5 @@ ok(!Mouse::Util::TypeConstraints::_detect_type_constraint_union($_), '... this correctly split the union (' . $_ . ')' ) for keys %split_tests; } + +done_testing; diff --git a/t/040_type_constraints/failing/016_subtyping_parameterized_types.t b/t-failing/040_type_constraints/016_subtyping_parameterized_types.t similarity index 87% rename from t/040_type_constraints/failing/016_subtyping_parameterized_types.t rename to t-failing/040_type_constraints/016_subtyping_parameterized_types.t index 2fa5f60..00f9665 100644 --- a/t/040_type_constraints/failing/016_subtyping_parameterized_types.t +++ b/t-failing/040_type_constraints/016_subtyping_parameterized_types.t @@ -1,9 +1,13 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 39; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; BEGIN { @@ -21,7 +25,7 @@ lives_ok { is($t->name, 'MySpecialHash', '... name is correct'); my $p = $t->parent; - isa_ok($p, 'Mouse::Meta::TypeConstraint::Parameterized'); + isa_ok($p, 'Mouse::Meta::TypeConstraint'); isa_ok($p, 'Mouse::Meta::TypeConstraint'); is($p->name, 'HashRef[Int]', '... parent name is correct'); @@ -53,7 +57,7 @@ lives_ok { is($t->name, 'MySpecialHashExtended', '... name is correct'); my $p = $t->parent; - isa_ok($p, 'Mouse::Meta::TypeConstraint::Parameterized'); + isa_ok($p, 'Mouse::Meta::TypeConstraint'); isa_ok($p, 'Mouse::Meta::TypeConstraint'); is($p->name, 'HashRef[Int]', '... parent name is correct'); @@ -73,7 +77,7 @@ lives_ok { my $t = find_type_constraint('MyNonSpecialHash'); isa_ok($t, 'Mouse::Meta::TypeConstraint'); - isa_ok($t, 'Mouse::Meta::TypeConstraint::Parameterizable'); + isa_ok($t, 'Mouse::Meta::TypeConstraint'); ok( $t->check({ one => 1, two => "foo", three => [] }), "validated" ); ok( !$t->check({ one => 1 }), "failed" ); @@ -119,3 +123,13 @@ lives_ok { as 'SubOfMyArrayRef[Str]'; }, qr/Str is not a subtype of BiggerInt/, 'Failed to parameterize with a bad type parameter'; } + +{ + my $RefToInt = subtype as 'ScalarRef[Int]'; + + ok $RefToInt->check(\1), '\1 is okay'; + ok !$RefToInt->check(1), '1 is not'; + ok !$RefToInt->check(\"foo"), '\"foo" is not'; +} + +done_testing; diff --git a/t/040_type_constraints/failing/019_coerced_parameterized_types.t b/t-failing/040_type_constraints/019_coerced_parameterized_types.t similarity index 86% rename from t/040_type_constraints/failing/019_coerced_parameterized_types.t rename to t-failing/040_type_constraints/019_coerced_parameterized_types.t index 5b57ad3..f3183fd 100644 --- a/t/040_type_constraints/failing/019_coerced_parameterized_types.t +++ b/t-failing/040_type_constraints/019_coerced_parameterized_types.t @@ -1,14 +1,18 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 11; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; BEGIN { use_ok("Mouse::Util::TypeConstraints"); - use_ok('Mouse::Meta::TypeConstraint::Parameterized'); + use_ok('Mouse::Meta::TypeConstraint'); } BEGIN { @@ -56,3 +60,4 @@ ok($evenlist->check(MyList->new(10, 20, 30, 40)), '... validated it correctly (p ok(!$evenlist->check(MyList->new(10, "two")), '... validated it correctly (fail)'); ok(!$evenlist->check([10, 20]), '... validated it correctly (fail)'); +done_testing; diff --git a/t/040_type_constraints/failing/020_class_type_constraint.t b/t-failing/040_type_constraints/020_class_type_constraint.t similarity index 56% rename from t/040_type_constraints/failing/020_class_type_constraint.t rename to t-failing/040_type_constraints/020_class_type_constraint.t index 05a9320..5cb9525 100644 --- a/t/040_type_constraints/failing/020_class_type_constraint.t +++ b/t-failing/040_type_constraints/020_class_type_constraint.t @@ -1,9 +1,13 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 20; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; BEGIN { @@ -32,6 +36,9 @@ my $type = find_type_constraint("Foo"); is( $type->class, "Foo", "class attribute" ); +ok( !$type->is_subtype_of('Foo'), "Foo is not subtype of Foo" ); +ok( !$type->is_subtype_of($type), '$foo_type is not subtype of $foo_type' ); + ok( $type->is_subtype_of("Gorch"), "subtype of gorch" ); ok( $type->is_subtype_of("Bar"), "subtype of bar" ); @@ -53,8 +60,14 @@ like( $error, qr/is not a Boop/, 'boop gives correct error message'); ok( $type->equals($type), "equals self" ); -ok( $type->equals(Mouse::Meta::TypeConstraint::Class->new( name => "__ANON__", class => "Foo" )), "equals anon constraint of same value" ); -ok( $type->equals(Mouse::Meta::TypeConstraint::Class->new( name => "Oink", class => "Foo" )), "equals differently named constraint of same value" ); -ok( !$type->equals(Mouse::Meta::TypeConstraint::Class->new( name => "__ANON__", class => "Bar" )), "doesn't equal other anon constraint" ); -ok( $type->is_subtype_of(Mouse::Meta::TypeConstraint::Class->new( name => "__ANON__", class => "Bar" )), "subtype of other anon constraint" ); +ok( $type->equals(Mouse::Meta::TypeConstraint->new( name => "__ANON__", class => "Foo" )), "equals anon constraint of same value" ); +ok( $type->equals(Mouse::Meta::TypeConstraint->new( name => "Oink", class => "Foo" )), "equals differently named constraint of same value" ); +ok( !$type->equals(Mouse::Meta::TypeConstraint->new( name => "__ANON__", class => "Bar" )), "doesn't equal other anon constraint" ); +ok( $type->is_subtype_of(Mouse::Meta::TypeConstraint->new( name => "__ANON__", class => "Bar" )), "subtype of other anon constraint" ); + +{ + my $regexp_type = Mouse::Meta::TypeConstraint->new(name => 'Regexp', class => 'Regexp'); + ok(!$regexp_type->check(qr//), 'a Regexp is not an instance of a class, even tho perl pretends it is'); +} +done_testing; diff --git a/t/040_type_constraints/failing/021_maybe_type_constraint.t b/t-failing/040_type_constraints/021_maybe_type_constraint.t similarity index 80% rename from t/040_type_constraints/failing/021_maybe_type_constraint.t rename to t-failing/040_type_constraints/021_maybe_type_constraint.t index 85fcff9..77b05f6 100644 --- a/t/040_type_constraints/failing/021_maybe_type_constraint.t +++ b/t-failing/040_type_constraints/021_maybe_type_constraint.t @@ -1,23 +1,27 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 36; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; use Mouse::Util::TypeConstraints; my $type = Mouse::Util::TypeConstraints::find_or_parse_type_constraint('Maybe[Int]'); isa_ok($type, 'Mouse::Meta::TypeConstraint'); -isa_ok($type, 'Mouse::Meta::TypeConstraint::Parameterized'); +isa_ok($type, 'Mouse::Meta::TypeConstraint'); ok( $type->equals($type), "equals self" ); ok( !$type->equals($type->parent), "not equal to parent" ); ok( !$type->equals(find_type_constraint("Maybe")), "not equal to Maybe" ); ok( $type->parent->equals(find_type_constraint("Maybe")), "parent is Maybe" ); -ok( $type->equals( Mouse::Meta::TypeConstraint::Parameterized->new( name => "__ANON__", parent => find_type_constraint("Maybe"), type_parameter => find_type_constraint("Int") ) ), "equal to clone" ); -ok( !$type->equals( Mouse::Meta::TypeConstraint::Parameterized->new( name => "__ANON__", parent => find_type_constraint("Maybe"), type_parameter => find_type_constraint("Str") ) ), "not equal to clone with diff param" ); +ok( $type->equals( Mouse::Meta::TypeConstraint->new( name => "__ANON__", parent => find_type_constraint("Maybe"), type_parameter => find_type_constraint("Int") ) ), "equal to clone" ); +ok( !$type->equals( Mouse::Meta::TypeConstraint->new( name => "__ANON__", parent => find_type_constraint("Maybe"), type_parameter => find_type_constraint("Str") ) ), "not equal to clone with diff param" ); ok( !$type->equals( Mouse::Util::TypeConstraints::find_or_parse_type_constraint('Maybe[Str]') ), "not equal to declarative version of diff param" ); ok($type->check(10), '... checked type correctly (pass)'); @@ -76,7 +80,7 @@ dies_ok { { - package Test::MouseX::Types::Maybe; + package Test::MooseX::Types::Maybe; use Mouse; has 'Maybe_Int' => (is=>'rw', isa=>'Maybe[Int]'); @@ -86,7 +90,7 @@ dies_ok { has 'Maybe_HashRefInt' => (is=>'rw', isa=>'Maybe[HashRef[Int]]'); } -ok my $obj = Test::MouseX::Types::Maybe->new +ok my $obj = Test::MooseX::Types::Maybe->new => 'Create good test object'; ## Maybe[Int] @@ -131,3 +135,5 @@ ok !$Maybe_Int->check("a") throws_ok sub { $obj->Maybe_Int("a") }, qr/Attribute \(Maybe_Int\) does not pass the type constraint/ => 'failed assigned ("a")'; + +done_testing; diff --git a/t/040_type_constraints/failing/024_role_type_constraint.t b/t-failing/040_type_constraints/024_role_type_constraint.t similarity index 64% rename from t/040_type_constraints/failing/024_role_type_constraint.t rename to t-failing/040_type_constraints/024_role_type_constraint.t index df04adc..1a7144d 100644 --- a/t/040_type_constraints/failing/024_role_type_constraint.t +++ b/t-failing/040_type_constraints/024_role_type_constraint.t @@ -1,9 +1,13 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 18; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; BEGIN { @@ -59,8 +63,9 @@ like( $error, qr/is not a Boop/, 'boop gives correct error message'); ok( $type->equals($type), "equals self" ); -ok( $type->equals(Mouse::Meta::TypeConstraint::Role->new( name => "__ANON__", role => "Foo" )), "equals anon constraint of same value" ); -ok( $type->equals(Mouse::Meta::TypeConstraint::Role->new( name => "Oink", role => "Foo" )), "equals differently named constraint of same value" ); -ok( !$type->equals(Mouse::Meta::TypeConstraint::Role->new( name => "__ANON__", role => "Bar" )), "doesn't equal other anon constraint" ); -ok( $type->is_subtype_of(Mouse::Meta::TypeConstraint::Role->new( name => "__ANON__", role => "Bar" )), "subtype of other anon constraint" ); +ok( $type->equals(Mouse::Meta::TypeConstraint->new( name => "__ANON__", role => "Foo" )), "equals anon constraint of same value" ); +ok( $type->equals(Mouse::Meta::TypeConstraint->new( name => "Oink", role => "Foo" )), "equals differently named constraint of same value" ); +ok( !$type->equals(Mouse::Meta::TypeConstraint->new( name => "__ANON__", role => "Bar" )), "doesn't equal other anon constraint" ); +ok( $type->is_subtype_of(Mouse::Meta::TypeConstraint->new( name => "__ANON__", role => "Bar" )), "subtype of other anon constraint" ); +done_testing; diff --git a/t/040_type_constraints/failing/026_normalize_type_name.t b/t-failing/040_type_constraints/026_normalize_type_name.t similarity index 95% rename from t/040_type_constraints/failing/026_normalize_type_name.t rename to t-failing/040_type_constraints/026_normalize_type_name.t index e2bc02d..345d159 100644 --- a/t/040_type_constraints/failing/026_normalize_type_name.t +++ b/t-failing/040_type_constraints/026_normalize_type_name.t @@ -1,9 +1,13 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 37; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; BEGIN { @@ -149,3 +153,5 @@ is $union1->name, $union2->name, 'names match'; is $union1->name, $union3->name, 'names match'; is $union2->name, $union3->name, 'names match'; + +done_testing; diff --git a/t/040_type_constraints/failing/030_class_subtypes.t b/t-failing/040_type_constraints/030_class_subtypes.t similarity index 77% rename from t/040_type_constraints/failing/030_class_subtypes.t rename to t-failing/040_type_constraints/030_class_subtypes.t index 6927c3f..594c16e 100644 --- a/t/040_type_constraints/failing/030_class_subtypes.t +++ b/t-failing/040_type_constraints/030_class_subtypes.t @@ -1,9 +1,13 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 26; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; use Mouse::Util::TypeConstraints; @@ -13,7 +17,7 @@ use Mouse::Meta::TypeConstraint; ## Create a subclass with a custom method { - package Test::Mouse::Meta::TypeConstraint::AnySubType; + package Test::Mouse::Meta::TypeConstraint; use Mouse; extends 'Mouse::Meta::TypeConstraint'; @@ -23,11 +27,11 @@ use Mouse::Meta::TypeConstraint; } my $Int = find_type_constraint('Int'); -ok $Int, 'Got a good type contstraint'; +ok $Int, 'Got a good type constraint'; -my $parent = Test::Mouse::Meta::TypeConstraint::AnySubType->new({ - name => "Test::Mouse::Meta::TypeConstraint::AnySubType" , - parent => $Int, +my $parent = Test::Mouse::Meta::TypeConstraint->new({ + name => "Test::Mouse::Meta::TypeConstraint" , + parent => $Int, }); ok $parent, 'Created type constraint'; @@ -80,10 +84,10 @@ ok $isa_foo, 'Created subtype of Foo type'; ok $isa_foo->check( Foo->new ), 'Foo passes check'; ok $isa_foo->check( Bar->new ), 'Bar passes check'; ok ! $isa_foo->check( Baz->new ), 'Baz does not pass check'; -like $foo->get_message( Baz->new ), qr/^Validation failed for 'Foo' failed with value Baz=HASH\(0x\w+\) \(not isa Foo\)/, 'Better validation message'; +like $foo->get_message( Baz->new ), qr/^Validation failed for 'Foo' with value Baz=HASH\(0x\w+\) \(not isa Foo\)/, 'Better validation message'; # Maybe in the future this *should* inherit? -like $isa_foo->get_message( Baz->new ), qr/^Validation failed for 'IsaFoo' failed with value Baz=HASH\(0x\w+\)$/, "Subtypes do not automatically inherit parent type's message"; +like $isa_foo->get_message( Baz->new ), qr/^Validation failed for 'IsaFoo' with value Baz=HASH\(0x\w+\)$/, "Subtypes do not automatically inherit parent type's message"; # Implicit types @@ -100,7 +104,7 @@ like $isa_foo->get_message( Baz->new ), qr/^Validation failed for 'IsaFoo' faile throws_ok { Quux->new(age => 3) -} qr/^Attribute \(age\) does not pass the type constraint because: Validation failed for 'Positive' failed with value 3 \(not isa Positive\)/; +} qr/^Attribute \(age\) does not pass the type constraint because: Validation failed for 'Positive' with value 3 \(not isa Positive\)/; lives_ok { Quux->new(age => (bless {}, 'Positive')); @@ -113,7 +117,7 @@ eval " throws_ok { Quux->new(age => 3) -} qr/^Attribute \(age\) does not pass the type constraint because: Validation failed for 'Positive' failed with value 3 \(not isa Positive\)/; +} qr/^Attribute \(age\) does not pass the type constraint because: Validation failed for 'Positive' with value 3 \(not isa Positive\)/; lives_ok { Quux->new(age => Positive->new) @@ -139,3 +143,5 @@ throws_ok { lives_ok { Quux::Ier->new(age => (bless {}, 'Negative')) }; + +done_testing; diff --git a/t/040_type_constraints/failing/033_type_names.t b/t-failing/040_type_constraints/033_type_names.t similarity index 83% rename from t/040_type_constraints/failing/033_type_names.t rename to t-failing/040_type_constraints/033_type_names.t index cdfee29..414f2e2 100644 --- a/t/040_type_constraints/failing/033_type_names.t +++ b/t-failing/040_type_constraints/033_type_names.t @@ -1,7 +1,11 @@ use strict; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use warnings; -use Test::More tests => 6; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; use Mouse::Meta::TypeConstraint; @@ -34,3 +38,5 @@ is( Mouse::Util::TypeConstraints::find_or_parse_type_constraint('ArrayRef[In-val is( Mouse::Util::TypeConstraints::find_or_parse_type_constraint('ArrayRef[Va.lid]'), 'ArrayRef[Va.lid]', 'find_or_parse_type_constraint returns name for valid name' ); + +done_testing; diff --git a/t/040_type_constraints/failing/035_duck_type_handles.t b/t-failing/040_type_constraints/035_duck_type_handles.t similarity index 77% rename from t/040_type_constraints/failing/035_duck_type_handles.t rename to t-failing/040_type_constraints/035_duck_type_handles.t index 40fe414..6a8f896 100644 --- a/t/040_type_constraints/failing/035_duck_type_handles.t +++ b/t-failing/040_type_constraints/035_duck_type_handles.t @@ -1,8 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 2; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; my @phonograph; @@ -44,3 +48,4 @@ is_deeply([splice @phonograph], ['quack']); $t->walk; is_deeply([splice @phonograph], ['footsteps']); +done_testing; diff --git a/t/040_type_constraints/failing/036_match_type_operator.t b/t-failing/040_type_constraints/036_match_type_operator.t similarity index 96% rename from t/040_type_constraints/failing/036_match_type_operator.t rename to t-failing/040_type_constraints/036_match_type_operator.t index 524c42d..7da38e0 100644 --- a/t/040_type_constraints/failing/036_match_type_operator.t +++ b/t-failing/040_type_constraints/036_match_type_operator.t @@ -1,9 +1,13 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 25; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; use Mouse::Util::TypeConstraints; @@ -223,6 +227,4 @@ throws_ok { not_enough_matches( [] ) } qr/No cases matched for /, '... not enough matches'; - - - +done_testing; diff --git a/t/050_metaclasses/failing/003_moose_w_metaclass.t b/t-failing/050_metaclasses/003_moose_w_metaclass.t similarity index 78% rename from t/050_metaclasses/failing/003_moose_w_metaclass.t rename to t-failing/050_metaclasses/003_moose_w_metaclass.t index 19fd54e..22640b2 100644 --- a/t/050_metaclasses/failing/003_moose_w_metaclass.t +++ b/t-failing/050_metaclasses/003_moose_w_metaclass.t @@ -1,13 +1,16 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 4; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; - =pod This test demonstrates that Mouse will respect @@ -42,7 +45,7 @@ isa_ok(Foo->meta, 'Foo::Meta'); use strict; use warnings; - use base 'Class::MOP::Class'; + use base 'Mouse::Meta::Class'; package Bar; use strict; @@ -54,3 +57,5 @@ isa_ok(Foo->meta, 'Foo::Meta'); qr/^Bar already has a metaclass, but it does not inherit Mouse::Meta::Class/, '... got the right error too'); } + +done_testing; diff --git a/t/050_metaclasses/failing/010_extending_and_embedding_back_compat.t b/t-failing/050_metaclasses/010_extending_and_embedding_back_compat.t similarity index 78% rename from t/050_metaclasses/failing/010_extending_and_embedding_back_compat.t rename to t-failing/050_metaclasses/010_extending_and_embedding_back_compat.t index d1e05d5..4a49b1a 100644 --- a/t/050_metaclasses/failing/010_extending_and_embedding_back_compat.t +++ b/t-failing/050_metaclasses/010_extending_and_embedding_back_compat.t @@ -1,13 +1,16 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 7; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; - BEGIN { package MyFramework::Base; use Mouse; @@ -19,6 +22,7 @@ BEGIN { package MyFramework; use Mouse; + use Mouse::Deprecated -api_version => '0.55'; sub import { my $CALLER = caller(); @@ -53,6 +57,4 @@ isa_ok($obj, 'Mouse::Object'); is($obj->foo, 10, '... got the right value'); - - - +done_testing; diff --git a/t/050_metaclasses/failing/014_goto_moose_import.t b/t-failing/050_metaclasses/014_goto_moose_import.t similarity index 61% rename from t/050_metaclasses/failing/014_goto_moose_import.t rename to t-failing/050_metaclasses/014_goto_moose_import.t index 063d4f0..4b5ea9e 100644 --- a/t/050_metaclasses/failing/014_goto_moose_import.t +++ b/t-failing/050_metaclasses/014_goto_moose_import.t @@ -1,16 +1,20 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 8; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; # Some packages out in the wild cooperate with Mouse by using goto # &Mouse::import. we want to make sure it still works. { - package MouseAlike1; + package MooseAlike1; use strict; use warnings; @@ -29,23 +33,23 @@ use Test::Exception; { package Foo; - MouseAlike1->import(); + MooseAlike1->import(); ::lives_ok( sub { has( 'size', is => 'bare' ) }, - 'has was exported via MouseAlike1' ); + 'has was exported via MooseAlike1' ); - MouseAlike1->unimport(); + MooseAlike1->unimport(); } ok( ! Foo->can('has'), - 'No has sub in Foo after MouseAlike1 is unimported' ); + 'No has sub in Foo after MooseAlike1 is unimported' ); ok( Foo->can('meta'), 'Foo has a meta method' ); isa_ok( Foo->meta(), 'Mouse::Meta::Class' ); { - package MouseAlike2; + package MooseAlike2; use strict; use warnings; @@ -66,17 +70,19 @@ isa_ok( Foo->meta(), 'Mouse::Meta::Class' ); { package Bar; - MouseAlike2->import(); + MooseAlike2->import(); ::lives_ok( sub { has( 'size', is => 'bare' ) }, - 'has was exported via MouseAlike2' ); + 'has was exported via MooseAlike2' ); - MouseAlike2->unimport(); + MooseAlike2->unimport(); } ok( ! Bar->can('has'), - 'No has sub in Bar after MouseAlike2 is unimported' ); + 'No has sub in Bar after MooseAlike2 is unimported' ); ok( Bar->can('meta'), 'Bar has a meta method' ); isa_ok( Bar->meta(), 'Mouse::Meta::Class' ); + +done_testing; diff --git a/t/050_metaclasses/failing/015_metarole.t b/t-failing/050_metaclasses/015_metarole.t similarity index 73% copy from t/050_metaclasses/failing/015_metarole.t copy to t-failing/050_metaclasses/015_metarole.t index 95f9e47..36e7fd0 100644 --- a/t/050_metaclasses/failing/015_metarole.t +++ b/t-failing/050_metaclasses/015_metarole.t @@ -1,11 +1,15 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; use lib 't/lib', 'lib'; -use Test::More 'no_plan'; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; use Mouse::Util::MetaRole; @@ -35,9 +39,9 @@ use Mouse::Util::MetaRole; } { - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => My::Class->meta, - metaclass_roles => ['Role::Foo'], + Mouse::Util::MetaRole::apply_metaroles( + for => My::Class->meta, + class_metaroles => { class => ['Role::Foo'] }, ); ok( My::Class->meta()->meta()->does_role('Role::Foo'), @@ -47,9 +51,9 @@ use Mouse::Util::MetaRole; } { - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class', - attribute_metaclass_roles => ['Role::Foo'], + Mouse::Util::MetaRole::apply_metaroles( + for => 'My::Class', + class_metaroles => { attribute => ['Role::Foo'] }, ); ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), @@ -63,9 +67,9 @@ use Mouse::Util::MetaRole; } { - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class', - method_metaclass_roles => ['Role::Foo'], + Mouse::Util::MetaRole::apply_metaroles( + for => 'My::Class', + class_metaroles => { method => ['Role::Foo'] }, ); ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'), @@ -81,10 +85,9 @@ use Mouse::Util::MetaRole; } { - last; # skip - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class', - wrapped_method_metaclass_roles => ['Role::Foo'], + Mouse::Util::MetaRole::apply_metaroles( + for => 'My::Class', + class_metaroles => { wrapped_method => ['Role::Foo'] }, ); ok( My::Class->meta()->wrapped_method_metaclass()->meta()->does_role('Role::Foo'), @@ -102,11 +105,9 @@ use Mouse::Util::MetaRole; } { - last; # skip - - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class', - instance_metaclass_roles => ['Role::Foo'], + Mouse::Util::MetaRole::apply_metaroles( + for => 'My::Class', + class_metaroles => { instance => ['Role::Foo'] }, ); ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), @@ -123,9 +124,9 @@ use Mouse::Util::MetaRole; } { - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class', - constructor_class_roles => ['Role::Foo'], + Mouse::Util::MetaRole::apply_metaroles( + for => 'My::Class', + class_metaroles => { constructor => ['Role::Foo'] }, ); ok( My::Class->meta()->constructor_class()->meta()->does_role('Role::Foo'), @@ -136,8 +137,8 @@ use Mouse::Util::MetaRole; q{... My::Class->meta()'s attribute metaclass still does Role::Foo} ); ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'), q{... My::Class->meta()'s method metaclass still does Role::Foo} ); -# ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), -# q{... My::Class->meta()'s instance metaclass still does Role::Foo} ); + ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), + q{... My::Class->meta()'s instance metaclass still does Role::Foo} ); # Actually instantiating the constructor class is too freaking hard! ok( My::Class->meta()->constructor_class()->can('foo'), @@ -145,9 +146,9 @@ use Mouse::Util::MetaRole; } { - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class', - destructor_class_roles => ['Role::Foo'], + Mouse::Util::MetaRole::apply_metaroles( + for => 'My::Class', + class_metaroles => { destructor => ['Role::Foo'] }, ); ok( My::Class->meta()->destructor_class()->meta()->does_role('Role::Foo'), @@ -158,8 +159,8 @@ use Mouse::Util::MetaRole; q{... My::Class->meta()'s attribute metaclass still does Role::Foo} ); ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'), q{... My::Class->meta()'s method metaclass still does Role::Foo} ); -# ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), -# q{... My::Class->meta()'s instance metaclass still does Role::Foo} ); + ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), + q{... My::Class->meta()'s instance metaclass still does Role::Foo} ); ok( My::Class->meta()->constructor_class()->meta()->does_role('Role::Foo'), q{... My::Class->meta()'s constructor class still does Role::Foo} ); @@ -169,11 +170,9 @@ use Mouse::Util::MetaRole; } { - last; # skip - - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Role', - application_to_class_class_roles => ['Role::Foo'], + Mouse::Util::MetaRole::apply_metaroles( + for => 'My::Role', + role_metaroles => { application_to_class => ['Role::Foo'] }, ); ok( My::Role->meta->application_to_class_class->meta->does_role('Role::Foo'), @@ -184,11 +183,9 @@ use Mouse::Util::MetaRole; } { - last; # skip - - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Role', - application_to_role_class_roles => ['Role::Foo'], + Mouse::Util::MetaRole::apply_metaroles( + for => 'My::Role', + role_metaroles => { application_to_role => ['Role::Foo'] }, ); ok( My::Role->meta->application_to_role_class->meta->does_role('Role::Foo'), @@ -201,11 +198,9 @@ use Mouse::Util::MetaRole; } { - last; # skip - - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Role', - application_to_instance_class_roles => ['Role::Foo'], + Mouse::Util::MetaRole::apply_metaroles( + for => 'My::Role', + role_metaroles => { application_to_instance => ['Role::Foo'] }, ); ok( My::Role->meta->application_to_instance_class->meta->does_role('Role::Foo'), @@ -221,8 +216,8 @@ use Mouse::Util::MetaRole; { Mouse::Util::MetaRole::apply_base_class_roles( - for_class => 'My::Class', - roles => ['Role::Foo'], + for => 'My::Class', + roles => ['Role::Foo'], ); ok( My::Class->meta()->does_role('Role::Foo'), @@ -238,14 +233,16 @@ use Mouse::Util::MetaRole; } { - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class2', - metaclass_roles => ['Role::Foo'], - attribute_metaclass_roles => ['Role::Foo'], - method_metaclass_roles => ['Role::Foo'], - instance_metaclass_roles => ['Role::Foo'], - constructor_class_roles => ['Role::Foo'], - destructor_class_roles => ['Role::Foo'], + Mouse::Util::MetaRole::apply_metaroles( + for => 'My::Class2', + class_metaroles => { + class => ['Role::Foo'], + attribute => ['Role::Foo'], + method => ['Role::Foo'], + instance => ['Role::Foo'], + constructor => ['Role::Foo'], + destructor => ['Role::Foo'], + }, ); ok( My::Class2->meta()->meta()->does_role('Role::Foo'), @@ -266,10 +263,10 @@ use Mouse::Util::MetaRole; is( My::Class2->meta()->get_method('bar')->foo(), 10, '... call foo() on a method metaclass object' ); -# ok( My::Class2->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), -# q{apply Role::Foo to My::Class2->meta()'s instance metaclass} ); -# is( My::Class2->meta()->get_meta_instance()->foo(), 10, -# '... call foo() on an instance metaclass object' ); + ok( My::Class2->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), + q{apply Role::Foo to My::Class2->meta()'s instance metaclass} ); + is( My::Class2->meta()->get_meta_instance()->foo(), 10, + '... call foo() on an instance metaclass object' ); ok( My::Class2->meta()->constructor_class()->meta()->does_role('Role::Foo'), q{apply Role::Foo to My::Class2->meta()'s constructor class} ); @@ -305,9 +302,9 @@ use Mouse::Util::MetaRole; { - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class3', - metaclass_roles => ['Role::Foo'], + Mouse::Util::MetaRole::apply_metaroles( + for => 'My::Class3', + class_metaroles => { class => ['Role::Foo'] }, ); ok( My::Class3->meta()->meta()->does_role('Role::Foo'), @@ -315,7 +312,7 @@ use Mouse::Util::MetaRole; is( My::Class3->meta()->foo(), 10, '... and call foo() on that meta object' ); ok( ( grep { $_ eq 'My::Meta::Class' } My::Class3->meta()->meta()->superclasses() ), - 'apply_metaclass_roles() does not interfere with metaclass set via Mouse->init_meta()' ); + 'apply_metaroles() does not interfere with metaclass set via Mouse->init_meta()' ); } { @@ -330,17 +327,17 @@ use Mouse::Util::MetaRole; } { - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class4', - metaclass_roles => ['Role::Foo'], + Mouse::Util::MetaRole::apply_metaroles( + for => 'My::Class4', + class_metaroles => { class => ['Role::Foo'] }, ); ok( My::Class4->meta()->meta()->does_role('Role::Foo'), 'apply Role::Foo to My::Class4->meta()' ); - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class4', - metaclass_roles => ['Role::Bar'], + Mouse::Util::MetaRole::apply_metaroles( + for => 'My::Class4', + class_metaroles => { class => ['Role::Bar'] }, ); ok( My::Class4->meta()->meta()->does_role('Role::Bar'), @@ -352,7 +349,7 @@ use Mouse::Util::MetaRole; { package My::Class5; use Mouse; - + extends 'My::Class'; } @@ -370,11 +367,11 @@ use Mouse::Util::MetaRole; ok( My::Class5->meta()->destructor_class()->meta()->does_role('Role::Foo'), q{My::Class5->meta()'s destructor class also does Role::Foo} ); } -exit; + { - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class5', - metaclass_roles => ['Role::Bar'], + Mouse::Util::MetaRole::apply_metaroles( + for => 'My::Class5', + class_metaroles => { class => ['Role::Bar'] }, ); ok( My::Class5->meta()->meta()->does_role('Role::Bar'), @@ -387,9 +384,9 @@ exit; package My::Class6; use Mouse; - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class6', - metaclass_roles => ['Role::Bar'], + Mouse::Util::MetaRole::apply_metaroles( + for => 'My::Class6', + class_metaroles => { class => ['Role::Bar'] }, ); extends 'My::Class'; @@ -412,12 +409,12 @@ exit; use Mouse; # In real usage this would go in a BEGIN block so it happened - # before apply_metaclass_roles was called by an extension. + # before apply_metaroles was called by an extension. extends 'My::Class'; - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class7', - metaclass_roles => ['Role::Bar'], + Mouse::Util::MetaRole::apply_metaroles( + for => 'My::Class7', + class_metaroles => { class => ['Role::Bar'] }, ); } @@ -432,10 +429,12 @@ exit; package My::Class8; use Mouse; - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class8', - metaclass_roles => ['Role::Bar'], - attribute_metaclass_roles => ['Role::Bar'], + Mouse::Util::MetaRole::apply_metaroles( + for => 'My::Class8', + class_metaroles => { + class => ['Role::Bar'], + attribute => ['Role::Bar'], + }, ); extends 'My::Class'; @@ -457,9 +456,9 @@ exit; package My::Class9; use Mouse; - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class9', - attribute_metaclass_roles => ['Role::Bar'], + Mouse::Util::MetaRole::apply_metaroles( + for => 'My::Class9', + class_metaroles => { attribute => ['Role::Bar'] }, ); extends 'My::Class'; @@ -477,7 +476,7 @@ exit; # This tests applying meta roles to a metaclass's metaclass. This is # completely insane, but is exactly what happens with # Fey::Meta::Class::Table. It's a subclass of Mouse::Meta::Class -# itself, and then it _uses_ MouseX::ClassAttribute, so the metaclass +# itself, and then it _uses_ MooseX::ClassAttribute, so the metaclass # for Fey::Meta::Class::Table does a role. # # At one point this caused a metaclass incompatibility error down @@ -488,9 +487,9 @@ exit; use Mouse; extends 'Mouse::Meta::Class'; - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Meta::Class2', - metaclass_roles => ['Role::Foo'], + Mouse::Util::MetaRole::apply_metaroles( + for => 'My::Meta::Class2', + class_metaroles => { class => ['Role::Foo'] }, ); } @@ -522,9 +521,9 @@ exit; package My::Class10; My::Meta2->import; - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class10', - metaclass_roles => ['Role::Bar'], + Mouse::Util::MetaRole::apply_metaroles( + for => 'My::Class10', + class_metaroles => { class => ['Role::Bar'] }, ); } @@ -542,7 +541,7 @@ exit; { package My::Constructor; - use base 'Mouse::Meta::Method::Constructor'; + use base 'Mouse::Meta::Method'; } { @@ -552,9 +551,9 @@ exit; __PACKAGE__->meta->constructor_class('My::Constructor'); - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class11', - metaclass_roles => ['Role::Foo'], + Mouse::Util::MetaRole::apply_metaroles( + for => 'My::Class11', + class_metaroles => { class => ['Role::Foo'] }, ); } @@ -566,28 +565,28 @@ exit; } { - package ExportsMouse; + package ExportsMoose; Mouse::Exporter->setup_import_methods( - also => 'Mouse', + also => 'Mouse', ); sub init_meta { shift; my %p = @_; Mouse->init_meta(%p); - return Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => $p{for_class}, + return Mouse::Util::MetaRole::apply_metaroles( + for => $p{for_class}, # Causes us to recurse through init_meta, as we have to # load MyMetaclassRole from disk. - metaclass_roles => [qw/MyMetaclassRole/], + class_metaroles => { class => [qw/MyMetaclassRole/] }, ); } } lives_ok { - package UsesExportedMouse; - ExportsMouse->import; + package UsesExportedMoose; + ExportsMoose->import; } 'import module which loads a role from disk during init_meta'; { @@ -595,23 +594,27 @@ lives_ok { use Mouse::Role; } + { package Foo::Role; Mouse::Exporter->setup_import_methods( - also => 'Mouse::Role', + also => 'Mouse::Role', ); sub init_meta { shift; my %p = @_; + Mouse::Role->init_meta(%p); - return Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => $p{for_class}, - method_metaclass_roles => [ 'Foo::Meta::Role', ], + + return Mouse::Util::MetaRole::apply_metaroles( + for => $p{for_class}, + role_metaroles => { method => ['Foo::Meta::Role'] }, ); } } + { package Role::Baz; @@ -619,6 +622,7 @@ lives_ok { sub bla {} } + { package My::Class12; @@ -626,11 +630,13 @@ lives_ok { with( 'Role::Baz' ); } + { ok( My::Class12->meta->does_role( 'Role::Baz' ), 'role applied' ); + my $method = My::Class12->meta->get_method( 'bla' ); ok( $method->meta->does_role( 'Foo::Meta::Role' ), @@ -642,9 +648,9 @@ lives_ok { package Parent; use Mouse; - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => __PACKAGE__, - constructor_class_roles => ['Role::Foo'], + Mouse::Util::MetaRole::apply_metaroles( + for => __PACKAGE__, + class_metaroles => { constructor => ['Role::Foo'] }, ); } @@ -662,15 +668,12 @@ lives_ok { 'Parent constructor class has metarole from Parent' ); -TODO: - { - local $TODO - = 'Mouse does not see that the child differs from the parent because it only checks the class and instance metaclasses do determine compatibility'; - ok( - Child->meta->constructor_class->meta->can('does_role') - && Child->meta->constructor_class->meta->does_role( - 'Role::Foo'), - 'Child constructor class has metarole from Parent' - ); - } + ok( + Child->meta->constructor_class->meta->can('does_role') + && Child->meta->constructor_class->meta->does_role( + 'Role::Foo'), + 'Child constructor class has metarole from Parent' + ); } + +done_testing; diff --git a/t/050_metaclasses/failing/016_metarole_w_metaclass_pm.t b/t-failing/050_metaclasses/016_metarole_w_metaclass_pm.t similarity index 78% rename from t/050_metaclasses/failing/016_metarole_w_metaclass_pm.t rename to t-failing/050_metaclasses/016_metarole_w_metaclass_pm.t index e899624..00cf161 100644 --- a/t/050_metaclasses/failing/016_metarole_w_metaclass_pm.t +++ b/t-failing/050_metaclasses/016_metarole_w_metaclass_pm.t @@ -1,9 +1,13 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 8; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Mouse::Util::MetaRole; @@ -62,23 +66,25 @@ BEGIN } { - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class', - metaclass_roles => ['Role::Foo'], + Mouse::Util::MetaRole::apply_metaroles( + for => 'My::Class', + class_metaroles => { class => ['Role::Foo'] }, ); ok( My::Class->meta()->meta()->does_role('Role::Foo'), 'apply Role::Foo to My::Class->meta()' ); has_superclass( My::Class->meta(), 'My::Meta::Class', - 'apply_metaclass_roles works with metaclass.pm' ); + 'apply_metaroles works with metaclass.pm' ); } { - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class2', - attribute_metaclass_roles => ['Role::Foo'], - method_metaclass_roles => ['Role::Foo'], - instance_metaclass_roles => ['Role::Foo'], + Mouse::Util::MetaRole::apply_metaroles( + for => 'My::Class2', + class_metaroles => { + attribute => ['Role::Foo'], + method => ['Role::Foo'], + instance => ['Role::Foo'], + }, ); ok( My::Class2->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), @@ -107,3 +113,5 @@ sub has_superclass { ok( $supers{$parent}, $desc ); } + +done_testing; diff --git a/t/050_metaclasses/failing/018_throw_error.t b/t-failing/050_metaclasses/018_throw_error.t similarity index 70% rename from t/050_metaclasses/failing/018_throw_error.t rename to t-failing/050_metaclasses/018_throw_error.t index 1be8cb5..837c6dd 100644 --- a/t/050_metaclasses/failing/018_throw_error.t +++ b/t-failing/050_metaclasses/018_throw_error.t @@ -1,9 +1,13 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 24; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; { @@ -22,17 +26,20 @@ use Test::Exception; has foo => ( is => "ro" ); - package Baz::Error; - use Mouse; - - has message => ( isa => "Str", is => "ro" ); - has attr => ( isa => "Mouse::Meta::Attribute", is => "ro" ); - has method => ( isa => "Mouse::Meta::Method", is => "ro" ); - has metaclass => ( isa => "Mouse::Meta::Class", is => "ro" ); - has data => ( is => "ro" ); - has line => ( isa => "Int", is => "ro" ); - has file => ( isa => "Str", is => "ro" ); - has last_error => ( isa => "Any", is => "ro" ); + BEGIN { + package Baz::Error; + use Mouse; + extends 'Mouse::Object', 'Mouse::Error::Default'; + + has message => ( isa => "Str", is => "ro" ); + has attr => ( isa => "Mouse::Meta::Attribute", is => "ro" ); + has method => ( isa => "Mouse::Meta::Method", is => "ro" ); + has metaclass => ( isa => "Mouse::Meta::Class", is => "ro" ); + has data => ( is => "ro" ); + has line => ( isa => "Int", is => "ro" ); + has file => ( isa => "Str", is => "ro" ); + has last_error => ( isa => "Any", is => "ro" ); + } package Baz; use metaclass ( @@ -102,9 +109,9 @@ sub create_error { use Mouse; extends 'Baz'; - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => __PACKAGE__, - metaclass_roles => ['Role::Foo'], + Mouse::Util::MetaRole::apply_metaroles( + for => __PACKAGE__, + class_metaroles => { class => ['Role::Foo'] }, ); } @@ -129,9 +136,9 @@ sub create_error { use Mouse; - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => __PACKAGE__, - metaclass_roles => ['Role::Foo'], + Mouse::Util::MetaRole::apply_metaroles( + for => __PACKAGE__, + class_metaroles => { class => ['Role::Foo'] }, ); } @@ -144,9 +151,9 @@ ok( Foo::Sub->meta->error_class->isa('Mouse::Error::Croak'), ::lives_ok { extends 'Foo::Sub' } 'error_class differs by role so incompat is handled'; - Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => __PACKAGE__, - error_class_roles => ['Role::Foo'], + Mouse::Util::MetaRole::apply_metaroles( + for => __PACKAGE__, + class_metaroles => { error => ['Role::Foo'] }, ); } @@ -154,3 +161,5 @@ ok( Foo::Sub::Sub->meta->error_class->meta->does_role('Role::Foo'), q{Foo::Sub::Sub's error_class does Role::Foo} ); ok( Foo::Sub::Sub->meta->error_class->isa('Mouse::Error::Croak'), q{Foo::Sub::Sub's error_class now subclasses Mouse::Error::Croak} ); + +done_testing; diff --git a/t/050_metaclasses/failing/019_create_anon_with_required_attr.t b/t-failing/050_metaclasses/019_create_anon_with_required_attr.t similarity index 90% rename from t/050_metaclasses/failing/019_create_anon_with_required_attr.t rename to t-failing/050_metaclasses/019_create_anon_with_required_attr.t index 3f4d227..aecf1d4 100644 --- a/t/050_metaclasses/failing/019_create_anon_with_required_attr.t +++ b/t-failing/050_metaclasses/019_create_anon_with_required_attr.t @@ -1,4 +1,7 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; # this functionality may be pushing toward parametric roles/classes # it's off in a corner and may not be that important @@ -6,7 +9,8 @@ use strict; use warnings; -use Test::More tests => 15; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; { @@ -85,3 +89,4 @@ dies_ok { die $@ if $@; } 'failed to use trait without required attr'; +done_testing; diff --git a/t/050_metaclasses/failing/022_new_metaclass.t b/t-failing/050_metaclasses/022_new_metaclass.t similarity index 71% rename from t/050_metaclasses/failing/022_new_metaclass.t rename to t-failing/050_metaclasses/022_new_metaclass.t index 059d9d5..d4b6597 100644 --- a/t/050_metaclasses/failing/022_new_metaclass.t +++ b/t-failing/050_metaclasses/022_new_metaclass.t @@ -1,7 +1,11 @@ #!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 2; +use Test::More; +$TODO = q{Mouse is not yet completed}; do { package My::Meta::Class; @@ -25,3 +29,4 @@ do { is(My::Class->meta->meta->name, 'My::Meta::Class'); is(My::Class::Aliased->meta->meta->name, 'My::Meta::Class'); +done_testing; diff --git a/t/050_metaclasses/failing/023_easy_init_meta.t b/t-failing/050_metaclasses/023_easy_init_meta.t similarity index 57% rename from t/050_metaclasses/failing/023_easy_init_meta.t rename to t-failing/050_metaclasses/023_easy_init_meta.t index 6da26d8..ed85866 100644 --- a/t/050_metaclasses/failing/023_easy_init_meta.t +++ b/t-failing/050_metaclasses/023_easy_init_meta.t @@ -1,9 +1,13 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 13; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Mouse qw(does_ok); { @@ -26,9 +30,12 @@ use Test::Mouse qw(does_ok); use Mouse::Exporter; Mouse::Exporter->setup_import_methods( - metaclass_roles => ['Foo::Trait::Class'], - attribute_metaclass_roles => ['Foo::Trait::Attribute'], - base_class_roles => ['Foo::Role::Base'], + class_metaroles => { + class => ['Foo::Trait::Class'], + attribute => ['Foo::Trait::Attribute'], + }, + role_metaroles => { role => ['Foo::Trait::Class'] }, + base_class_roles => ['Foo::Role::Base'], ); } @@ -45,17 +52,19 @@ use Test::Mouse qw(does_ok); } { - package Foo::Exporter::WithMouse; + package Foo::Exporter::WithMoose; use Mouse (); use Mouse::Exporter; - my ($import, $unimport, $init_meta) = - Mouse::Exporter->build_import_methods( - also => 'Mouse', - metaclass_roles => ['Foo::Trait::Class'], - attribute_metaclass_roles => ['Foo::Trait::Attribute'], - base_class_roles => ['Foo::Role::Base'], - install => [qw(import unimport)], + my ( $import, $unimport, $init_meta ) + = Mouse::Exporter->build_import_methods( + also => 'Mouse', + class_metaroles => { + class => ['Foo::Trait::Class'], + attribute => ['Foo::Trait::Attribute'], + }, + base_class_roles => ['Foo::Role::Base'], + install => [qw(import unimport)], ); sub init_meta { @@ -69,7 +78,7 @@ use Test::Mouse qw(does_ok); { package Foo2; - Foo::Exporter::WithMouse->import; + Foo::Exporter::WithMoose->import; has(foo => (is => 'ro')); @@ -89,17 +98,18 @@ use Test::Mouse qw(does_ok); } { - package Foo::Exporter::WithMouseRole; + package Foo::Exporter::WithMooseRole; use Mouse::Role (); use Mouse::Exporter; - my ($import, $unimport, $init_meta) = - Mouse::Exporter->build_import_methods( - also => 'Mouse::Role', - metaclass_roles => ['Foo::Trait::Class'], - attribute_metaclass_roles => ['Foo::Trait::Attribute'], - base_class_roles => ['Foo::Role::Base'], - install => [qw(import unimport)], + my ( $import, $unimport, $init_meta ) + = Mouse::Exporter->build_import_methods( + also => 'Mouse::Role', + role_metaroles => { + role => ['Foo::Trait::Class'], + attribute => ['Foo::Trait::Attribute'], + }, + install => [qw(import unimport)], ); sub init_meta { @@ -113,8 +123,10 @@ use Test::Mouse qw(does_ok); { package Foo2::Role; - Foo::Exporter::WithMouseRole->import; + Foo::Exporter::WithMooseRole->import; ::isa_ok(Foo2::Role->meta, 'Mouse::Meta::Role'); ::does_ok(Foo2::Role->meta, 'Foo::Trait::Class'); } + +done_testing; diff --git a/t/050_metaclasses/failing/030_metarole_combination.t b/t-failing/050_metaclasses/030_metarole_combination.t similarity index 77% rename from t/050_metaclasses/failing/030_metarole_combination.t rename to t-failing/050_metaclasses/030_metarole_combination.t index b2fc134..0801149 100644 --- a/t/050_metaclasses/failing/030_metarole_combination.t +++ b/t-failing/050_metaclasses/030_metarole_combination.t @@ -1,6 +1,10 @@ use strict; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use warnings; use Test::More; +$TODO = q{Mouse is not yet completed}; our @applications; @@ -81,14 +85,16 @@ our @applications; around apply_params => sub { my ( $next, $self, @args ) = @_; - return Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => $self->$next(@args), - application_to_class_class_roles => - ['CustomApplication::Composite::ToClass'], - application_to_role_class_roles => - ['CustomApplication::Composite::ToRole'], - application_to_instance_class_roles => - ['CustomApplication::Composite::ToInstance'], + return Mouse::Util::MetaRole::apply_metaroles( + for => $self->$next(@args), + role_metaroles => { + application_to_class => + ['CustomApplication::Composite::ToClass'], + application_to_role => + ['CustomApplication::Composite::ToRole'], + application_to_instance => + ['CustomApplication::Composite::ToInstance'], + }, ); }; } @@ -97,9 +103,10 @@ our @applications; package Role::WithCustomApplication; use Mouse::Role; - has '+composition_class_roles' => ( - default => ['Role::Composite'], - ); + around composition_class_roles => sub { + my ($orig, $self) = @_; + return $self->$orig, 'Role::Composite'; + }; } { @@ -110,14 +117,16 @@ our @applications; sub init_meta { my ( $self, %options ) = @_; - return Mouse::Util::MetaRole::apply_metaclass_roles( - for_class => Mouse::Role->init_meta(%options), - metaclass_roles => ['Role::WithCustomApplication'], - application_to_class_class_roles => - ['CustomApplication::ToClass'], - application_to_role_class_roles => ['CustomApplication::ToRole'], - application_to_instance_class_roles => - ['CustomApplication::ToInstance'], + return Mouse::Util::MetaRole::apply_metaroles( + for => Mouse::Role->init_meta(%options), + role_metaroles => { + role => ['Role::WithCustomApplication'], + application_to_class => + ['CustomApplication::ToClass'], + application_to_role => ['CustomApplication::ToRole'], + application_to_instance => + ['CustomApplication::ToInstance'], + }, ); } } @@ -138,7 +147,7 @@ ok( My::Role::Special->meta->isa('Mouse::Meta::Role'), ); ok( My::Role::Special->meta->meta->does_role('Role::WithCustomApplication'), "the role's metaobject has custom applications" ); -is_deeply( My::Role::Special->meta->composition_class_roles, +is_deeply( [My::Role::Special->meta->composition_class_roles], ['Role::Composite'], "the role knows about the specified composition class" ); diff --git a/t/050_metaclasses/failing/015_metarole.t b/t-failing/050_metaclasses/050_metarole_backcompat.t similarity index 93% rename from t/050_metaclasses/failing/015_metarole.t rename to t-failing/050_metaclasses/050_metarole_backcompat.t index 95f9e47..ef06636 100644 --- a/t/050_metaclasses/failing/015_metarole.t +++ b/t-failing/050_metaclasses/050_metarole_backcompat.t @@ -1,15 +1,26 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +# This is a copy of 015_metarole.t taken on 01/01/2010. It provides a +# comprehensive test of backwards compatibility in the MetaRole API. use strict; use warnings; use lib 't/lib', 'lib'; -use Test::More 'no_plan'; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; use Mouse::Util::MetaRole; +{ + no warnings 'redefine'; + *Mouse::Deprecated::deprecated = sub { return }; +} { package My::Meta::Class; @@ -81,7 +92,6 @@ use Mouse::Util::MetaRole; } { - last; # skip Mouse::Util::MetaRole::apply_metaclass_roles( for_class => 'My::Class', wrapped_method_metaclass_roles => ['Role::Foo'], @@ -102,8 +112,6 @@ use Mouse::Util::MetaRole; } { - last; # skip - Mouse::Util::MetaRole::apply_metaclass_roles( for_class => 'My::Class', instance_metaclass_roles => ['Role::Foo'], @@ -136,8 +144,8 @@ use Mouse::Util::MetaRole; q{... My::Class->meta()'s attribute metaclass still does Role::Foo} ); ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'), q{... My::Class->meta()'s method metaclass still does Role::Foo} ); -# ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), -# q{... My::Class->meta()'s instance metaclass still does Role::Foo} ); + ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), + q{... My::Class->meta()'s instance metaclass still does Role::Foo} ); # Actually instantiating the constructor class is too freaking hard! ok( My::Class->meta()->constructor_class()->can('foo'), @@ -158,8 +166,8 @@ use Mouse::Util::MetaRole; q{... My::Class->meta()'s attribute metaclass still does Role::Foo} ); ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'), q{... My::Class->meta()'s method metaclass still does Role::Foo} ); -# ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), -# q{... My::Class->meta()'s instance metaclass still does Role::Foo} ); + ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), + q{... My::Class->meta()'s instance metaclass still does Role::Foo} ); ok( My::Class->meta()->constructor_class()->meta()->does_role('Role::Foo'), q{... My::Class->meta()'s constructor class still does Role::Foo} ); @@ -169,8 +177,6 @@ use Mouse::Util::MetaRole; } { - last; # skip - Mouse::Util::MetaRole::apply_metaclass_roles( for_class => 'My::Role', application_to_class_class_roles => ['Role::Foo'], @@ -184,8 +190,6 @@ use Mouse::Util::MetaRole; } { - last; # skip - Mouse::Util::MetaRole::apply_metaclass_roles( for_class => 'My::Role', application_to_role_class_roles => ['Role::Foo'], @@ -201,8 +205,6 @@ use Mouse::Util::MetaRole; } { - last; # skip - Mouse::Util::MetaRole::apply_metaclass_roles( for_class => 'My::Role', application_to_instance_class_roles => ['Role::Foo'], @@ -266,10 +268,10 @@ use Mouse::Util::MetaRole; is( My::Class2->meta()->get_method('bar')->foo(), 10, '... call foo() on a method metaclass object' ); -# ok( My::Class2->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), -# q{apply Role::Foo to My::Class2->meta()'s instance metaclass} ); -# is( My::Class2->meta()->get_meta_instance()->foo(), 10, -# '... call foo() on an instance metaclass object' ); + ok( My::Class2->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), + q{apply Role::Foo to My::Class2->meta()'s instance metaclass} ); + is( My::Class2->meta()->get_meta_instance()->foo(), 10, + '... call foo() on an instance metaclass object' ); ok( My::Class2->meta()->constructor_class()->meta()->does_role('Role::Foo'), q{apply Role::Foo to My::Class2->meta()'s constructor class} ); @@ -352,7 +354,7 @@ use Mouse::Util::MetaRole; { package My::Class5; use Mouse; - + extends 'My::Class'; } @@ -370,7 +372,7 @@ use Mouse::Util::MetaRole; ok( My::Class5->meta()->destructor_class()->meta()->does_role('Role::Foo'), q{My::Class5->meta()'s destructor class also does Role::Foo} ); } -exit; + { Mouse::Util::MetaRole::apply_metaclass_roles( for_class => 'My::Class5', @@ -477,7 +479,7 @@ exit; # This tests applying meta roles to a metaclass's metaclass. This is # completely insane, but is exactly what happens with # Fey::Meta::Class::Table. It's a subclass of Mouse::Meta::Class -# itself, and then it _uses_ MouseX::ClassAttribute, so the metaclass +# itself, and then it _uses_ MooseX::ClassAttribute, so the metaclass # for Fey::Meta::Class::Table does a role. # # At one point this caused a metaclass incompatibility error down @@ -542,7 +544,7 @@ exit; { package My::Constructor; - use base 'Mouse::Meta::Method::Constructor'; + use base 'Mouse::Meta::Method'; } { @@ -566,7 +568,7 @@ exit; } { - package ExportsMouse; + package ExportsMoose; Mouse::Exporter->setup_import_methods( also => 'Mouse', @@ -586,8 +588,8 @@ exit; } lives_ok { - package UsesExportedMouse; - ExportsMouse->import; + package UsesExportedMoose; + ExportsMoose->import; } 'import module which loads a role from disk during init_meta'; { @@ -662,15 +664,12 @@ lives_ok { 'Parent constructor class has metarole from Parent' ); -TODO: - { - local $TODO - = 'Mouse does not see that the child differs from the parent because it only checks the class and instance metaclasses do determine compatibility'; - ok( - Child->meta->constructor_class->meta->can('does_role') - && Child->meta->constructor_class->meta->does_role( - 'Role::Foo'), - 'Child constructor class has metarole from Parent' - ); - } + ok( + Child->meta->constructor_class->meta->can('does_role') + && Child->meta->constructor_class->meta->does_role( + 'Role::Foo'), + 'Child constructor class has metarole from Parent' + ); } + +done_testing; diff --git a/t-failing/050_metaclasses/052_metaclass_compat.t b/t-failing/050_metaclasses/052_metaclass_compat.t new file mode 100644 index 0000000..f3179d3 --- /dev/null +++ b/t-failing/050_metaclasses/052_metaclass_compat.t @@ -0,0 +1,309 @@ +#!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use strict; +use warnings; +use lib 't/lib'; +use Test::More; +$TODO = q{Mouse is not yet completed}; +use Test::Exception; + +our $called = 0; +{ + package Foo::Trait::Constructor; + use Mouse::Role; + + around _generate_BUILDALL => sub { + my $orig = shift; + my $self = shift; + return $self->$orig(@_) . '$::called++;'; + } +} + +{ + package Foo; + use Mouse; + Mouse::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 Mouse; + extends 'Foo'; +} + +$called = 0; + +Foo::Sub->new; +is($called, 0, "no calls before inlining"); + +Foo::Sub->meta->make_immutable; + +Foo::Sub->new; +is($called, 1, "inherits constructor trait properly"); + +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"); + +{ + package Foo2::Role; + use Mouse::Role; +} +{ + package Foo2; + use Mouse -traits => ['Foo2::Role']; +} +{ + package Bar2; + use Mouse; +} +{ + package Baz2; + use Mouse; + my $meta = __PACKAGE__->meta; + ::lives_ok { $meta->superclasses('Foo2') } "can set superclasses once"; + ::isa_ok($meta, Foo2->meta->meta->name); + ::lives_ok { $meta->superclasses('Bar2') } "can still set superclasses"; + ::isa_ok($meta, Bar2->meta->meta->name); + ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], + ['Foo2::Role'], + "still have the role attached"); + ::ok(!$meta->is_immutable, + "immutable superclass doesn't make this class immutable"); + ::lives_ok { $meta->make_immutable } "can still make immutable"; +} +{ + package Foo3::Role; + use Mouse::Role; +} +{ + package Bar3; + use Mouse -traits => ['Foo3::Role']; +} +{ + package Baz3; + use Mouse -traits => ['Foo3::Role']; + my $meta = __PACKAGE__->meta; + ::lives_ok { $meta->superclasses('Foo2') } "can set superclasses once"; + ::isa_ok($meta, Foo2->meta->meta->name); + ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], + ['Foo2::Role', 'Foo3::Role'], + "reconciled roles correctly"); + ::lives_ok { $meta->superclasses('Bar3') } "can still set superclasses"; + ::isa_ok($meta, Bar3->meta->meta->name); + ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], + ['Foo2::Role', 'Foo3::Role'], + "roles still the same"); + ::ok(!$meta->is_immutable, + "immutable superclass doesn't make this class immutable"); + ::lives_ok { $meta->make_immutable } "can still make immutable"; +} +{ + package Quux3; + use Mouse; +} +{ + package Quuux3; + use Mouse -traits => ['Foo3::Role']; + my $meta = __PACKAGE__->meta; + ::lives_ok { $meta->superclasses('Foo2') } "can set superclasses once"; + ::isa_ok($meta, Foo2->meta->meta->name); + ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], + ['Foo2::Role', 'Foo3::Role'], + "reconciled roles correctly"); + ::lives_ok { $meta->superclasses('Quux3') } "can still set superclasses"; + ::isa_ok($meta, Quux3->meta->meta->name); + ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], + ['Foo2::Role', 'Foo3::Role'], + "roles still the same"); + ::ok(!$meta->is_immutable, + "immutable superclass doesn't make this class immutable"); + ::lives_ok { $meta->make_immutable } "can still make immutable"; +} + +{ + package Foo4::Role; + use Mouse::Role; +} +{ + package Foo4; + use Mouse -traits => ['Foo4::Role']; + __PACKAGE__->meta->make_immutable; +} +{ + package Bar4; + use Mouse; +} +{ + package Baz4; + use Mouse; + my $meta = __PACKAGE__->meta; + ::lives_ok { $meta->superclasses('Foo4') } "can set superclasses once"; + ::isa_ok($meta, Foo4->meta->_get_mutable_metaclass_name); + ::lives_ok { $meta->superclasses('Bar4') } "can still set superclasses"; + ::isa_ok($meta, Bar4->meta->meta->name); + ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], + ['Foo4::Role'], + "still have the role attached"); + ::ok(!$meta->is_immutable, + "immutable superclass doesn't make this class immutable"); + ::lives_ok { $meta->make_immutable } "can still make immutable"; +} +{ + package Foo5::Role; + use Mouse::Role; +} +{ + package Bar5; + use Mouse -traits => ['Foo5::Role']; +} +{ + package Baz5; + use Mouse -traits => ['Foo5::Role']; + my $meta = __PACKAGE__->meta; + ::lives_ok { $meta->superclasses('Foo4') } "can set superclasses once"; + ::isa_ok($meta, Foo4->meta->_get_mutable_metaclass_name); + ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], + ['Foo4::Role', 'Foo5::Role'], + "reconciled roles correctly"); + ::lives_ok { $meta->superclasses('Bar5') } "can still set superclasses"; + ::isa_ok($meta, Bar5->meta->meta->name); + ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], + ['Foo4::Role', 'Foo5::Role'], + "roles still the same"); + ::ok(!$meta->is_immutable, + "immutable superclass doesn't make this class immutable"); + ::lives_ok { $meta->make_immutable } "can still make immutable"; +} +{ + package Quux5; + use Mouse; +} +{ + package Quuux5; + use Mouse -traits => ['Foo5::Role']; + my $meta = __PACKAGE__->meta; + ::lives_ok { $meta->superclasses('Foo4') } "can set superclasses once"; + ::isa_ok($meta, Foo4->meta->_get_mutable_metaclass_name); + ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], + ['Foo4::Role', 'Foo5::Role'], + "reconciled roles correctly"); + ::lives_ok { $meta->superclasses('Quux5') } "can still set superclasses"; + ::isa_ok($meta, Quux5->meta->meta->name); + ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], + ['Foo4::Role', 'Foo5::Role'], + "roles still the same"); + ::ok(!$meta->is_immutable, + "immutable superclass doesn't make this class immutable"); + ::lives_ok { $meta->make_immutable } "can still make immutable"; +} + +{ + package Foo5::Meta::Role; + use Mouse::Role; +} +{ + package Foo5::SuperClass::WithMetaRole; + use Mouse -traits =>'Foo5::Meta::Role'; +} +{ + package Foo5::SuperClass::After::Attribute; + use Mouse; +} +{ + package Foo5; + use Mouse; + my @superclasses = ('Foo5::SuperClass::WithMetaRole'); + extends @superclasses; + + has an_attribute_generating_methods => ( is => 'ro' ); + + push(@superclasses, 'Foo5::SuperClass::After::Attribute'); + + ::lives_ok { + extends @superclasses; + } 'MI extends after_generated_methods with metaclass roles'; + ::lives_ok { + extends reverse @superclasses; + } + 'MI extends after_generated_methods with metaclass roles (reverse)'; +} + +{ + package Foo6::Meta::Role; + use Mouse::Role; +} +{ + package Foo6::SuperClass::WithMetaRole; + use Mouse -traits =>'Foo6::Meta::Role'; +} +{ + package Foo6::Meta::OtherRole; + use Mouse::Role; +} +{ + package Foo6::SuperClass::After::Attribute; + use Mouse -traits =>'Foo6::Meta::OtherRole'; +} +{ + package Foo6; + use Mouse; + my @superclasses = ('Foo6::SuperClass::WithMetaRole'); + extends @superclasses; + + has an_attribute_generating_methods => ( is => 'ro' ); + + push(@superclasses, 'Foo6::SuperClass::After::Attribute'); + + ::throws_ok { + extends @superclasses; + } qr/compat.*pristine/, + 'unsafe MI extends after_generated_methods with metaclass roles'; + ::throws_ok { + extends reverse @superclasses; + } qr/compat.*pristine/, + 'unsafe MI extends after_generated_methods with metaclass roles (reverse)'; +} + +{ + package Foo7::Meta::Trait; + use Mouse::Role; +} + +{ + package Foo7; + use Mouse -traits => ['Foo7::Meta::Trait']; +} + +{ + package Bar7; + # in an external file + use Mouse -traits => ['Bar7::Meta::Trait']; + ::lives_ok { extends 'Foo7' } "role reconciliation works"; +} + +{ + package Bar72; + # in an external file + use Mouse -traits => ['Bar7::Meta::Trait2']; + ::lives_ok { extends 'Foo7' } "role reconciliation works"; +} + +done_testing; diff --git a/t-failing/060_compat/003_foreign_inheritence.t b/t-failing/060_compat/003_foreign_inheritence.t new file mode 100644 index 0000000..ed1cc6a --- /dev/null +++ b/t-failing/060_compat/003_foreign_inheritence.t @@ -0,0 +1,96 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; +$TODO = q{Mouse is not yet completed}; +use Test::Exception; + + +{ + + package Elk; + use strict; + use warnings; + + sub new { + my $class = shift; + bless { no_moose => "Elk" } => $class; + } + + sub no_moose { $_[0]->{no_moose} } + + package Foo::Mouse; + use Mouse; + + extends 'Elk'; + + has 'moose' => ( is => 'ro', default => 'Foo' ); + + sub new { + my $class = shift; + my $super = $class->SUPER::new(@_); + return $class->meta->new_object( '__INSTANCE__' => $super, @_ ); + } + + __PACKAGE__->meta->make_immutable( inline_constructor => 0, debug => 0 ); + + package Bucket; + use metaclass 'Mouse::Meta::Class'; + + __PACKAGE__->meta->add_attribute( + 'squeegee' => ( accessor => 'squeegee' ) ); + + package Old::Bucket::Nose; + + # see http://www.moosefoundation.org/moose_facts.htm + use Mouse; + + extends 'Bucket'; + + package MyBase; + sub foo { } + + package Custom::Meta1; + use base qw(Mouse::Meta::Class); + + package Custom::Meta2; + use base qw(Mouse::Meta::Class); + + package SubClass1; + use metaclass 'Custom::Meta1'; + use Mouse; + + extends 'MyBase'; + + package SubClass2; + use metaclass 'Custom::Meta2'; + use Mouse; + + # XXX FIXME subclassing meta-attrs and immutable-ing the subclass fails +} + +my $foo_moose = Foo::Mouse->new(); +isa_ok( $foo_moose, 'Foo::Mouse' ); +isa_ok( $foo_moose, 'Elk' ); + +is( $foo_moose->no_moose, 'Elk', + '... got the right value from the Elk method' ); +is( $foo_moose->moose, 'Foo', + '... got the right value from the Foo::Mouse method' ); + +lives_ok { + Old::Bucket::Nose->meta->make_immutable( debug => 0 ); +} +'Immutability on Mouse class extending Mouse::Meta class ok'; + +lives_ok { + SubClass2->meta->superclasses('MyBase'); +} +'Can subclass the same non-Mouse class twice with different metaclasses'; + +done_testing; diff --git a/t-failing/060_compat/004_extends_nonmoose_that_isa_moose_with_metarole.t b/t-failing/060_compat/004_extends_nonmoose_that_isa_moose_with_metarole.t new file mode 100644 index 0000000..c35bba6 --- /dev/null +++ b/t-failing/060_compat/004_extends_nonmoose_that_isa_moose_with_metarole.t @@ -0,0 +1,226 @@ +use strict; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use warnings; +use Test::More; +$TODO = q{Mouse is not yet completed}; +use Mouse::Meta (); + +{ + package My::Role; + use Mouse::Role; +} + +{ + package SomeClass; + use Mouse -traits => 'My::Role'; +} + +{ + package SubClassUseBase; + use base qw/SomeClass/; +} + +{ + package SubSubClassUseBase; + use Mouse; + use Test::More; +$TODO = q{Mouse is not yet completed}; + use Test::Exception; + lives_ok { + extends 'SubClassUseBase'; + } + 'Can extend non-Mouse class with parent class that is a Mouse class with a meta role'; +} + +{ + ok( SubSubClassUseBase->meta->meta->can('does_role') + && SubSubClassUseBase->meta->meta->does_role('My::Role'), + 'SubSubClassUseBase meta metaclass does the My::Role role' ); +} + +# Note, remove metaclasses of the 'use base' classes after each test, +# so that they have to be re-initialized - otherwise latter tests +# would not demonstrate the original issue. +Mouse::Util::remove_metaclass_by_name('SubClassUseBase'); + +{ + package OtherClass; + use Mouse; +} + +{ + package OtherSubClassUseBase; + use base 'OtherClass'; +} + +{ + package MultiParent1; + use Mouse; + use Test::More; +$TODO = q{Mouse is not yet completed}; + use Test::Exception; + lives_ok { + extends qw( SubClassUseBase OtherSubClassUseBase ); + } + 'Can extend two non-Mouse classes with parents that are different Mouse metaclasses'; +} + +{ + ok( MultiParent1->meta->meta->can('does_role') + && MultiParent1->meta->meta->does_role('My::Role'), + 'MultiParent1 meta metaclass does the My::Role role' ); +} + +Mouse::Util::remove_metaclass_by_name($_) + for qw( SubClassUseBase OtherSubClassUseBase ); + +{ + package MultiParent2; + use Mouse; + use Test::More; +$TODO = q{Mouse is not yet completed}; + use Test::Exception; + lives_ok { + extends qw( OtherSubClassUseBase SubClassUseBase ); + } + 'Can extend two non-Mouse classes with parents that are different Mouse metaclasses (reverse order)'; +} + +{ + ok( MultiParent2->meta->meta->can('does_role') + && MultiParent2->meta->meta->does_role('My::Role'), + 'MultiParent2 meta metaclass does the My::Role role' ); +} + +Mouse::Util::remove_metaclass_by_name($_) + for qw( SubClassUseBase OtherSubClassUseBase ); + +{ + package MultiParent3; + use Mouse; + use Test::More; +$TODO = q{Mouse is not yet completed}; + use Test::Exception; + lives_ok { + extends qw( OtherClass SubClassUseBase ); + } + 'Can extend one Mouse class and one non-Mouse class'; +} + +{ + ok( MultiParent3->meta->meta->can('does_role') + && MultiParent3->meta->meta->does_role('My::Role'), + 'MultiParent3 meta metaclass does the My::Role role' ); +} + +Mouse::Util::remove_metaclass_by_name($_) + for qw( SubClassUseBase OtherSubClassUseBase ); + +{ + package MultiParent4; + use Mouse; + use Test::More; +$TODO = q{Mouse is not yet completed}; + use Test::Exception; + lives_ok { + extends qw( SubClassUseBase OtherClass ); + } + 'Can extend one non-Mouse class and one Mouse class'; +} + +{ + ok( MultiParent4->meta->meta->can('does_role') + && MultiParent4->meta->meta->does_role('My::Role'), + 'MultiParent4 meta metaclass does the My::Role role' ); +} + +Mouse::Util::remove_metaclass_by_name($_) + for qw( SubClassUseBase OtherSubClassUseBase ); + +{ + package MultiChild1; + use Mouse; + use Test::More; +$TODO = q{Mouse is not yet completed}; + use Test::Exception; + lives_ok { + extends 'MultiParent1'; + } + 'Can extend class that itself extends two non-Mouse classes with Mouse parents'; +} + +{ + ok( MultiChild1->meta->meta->can('does_role') + && MultiChild1->meta->meta->does_role('My::Role'), + 'MultiChild1 meta metaclass does the My::Role role' ); +} + +Mouse::Util::remove_metaclass_by_name($_) + for qw( SubClassUseBase OtherSubClassUseBase ); + +{ + package MultiChild2; + use Mouse; + use Test::More; +$TODO = q{Mouse is not yet completed}; + use Test::Exception; + lives_ok { + extends 'MultiParent2'; + } + 'Can extend class that itself extends two non-Mouse classes with Mouse parents (reverse order)'; +} + +{ + ok( MultiChild2->meta->meta->can('does_role') + && MultiChild2->meta->meta->does_role('My::Role'), + 'MultiChild2 meta metaclass does the My::Role role' ); +} + +Mouse::Util::remove_metaclass_by_name($_) + for qw( SubClassUseBase OtherSubClassUseBase ); + +{ + package MultiChild3; + use Mouse; + use Test::More; +$TODO = q{Mouse is not yet completed}; + use Test::Exception; + lives_ok { + extends 'MultiParent3'; + } + 'Can extend class that itself extends one Mouse and one non-Mouse parent'; +} + +{ + ok( MultiChild3->meta->meta->can('does_role') + && MultiChild3->meta->meta->does_role('My::Role'), + 'MultiChild3 meta metaclass does the My::Role role' ); +} + +Mouse::Util::remove_metaclass_by_name($_) + for qw( SubClassUseBase OtherSubClassUseBase ); + +{ + package MultiChild4; + use Mouse; + use Test::More; +$TODO = q{Mouse is not yet completed}; + use Test::Exception; + lives_ok { + extends 'MultiParent4'; + } + 'Can extend class that itself extends one non-Mouse and one Mouse parent'; +} + +{ + ok( MultiChild4->meta->meta->can('does_role') + && MultiChild4->meta->meta->does_role('My::Role'), + 'MultiChild4 meta metaclass does the My::Role role' ); +} + +Mouse::Util::remove_metaclass_by_name($_) + for qw( SubClassUseBase OtherSubClassUseBase ); + +done_testing; diff --git a/t-failing/070_native_traits/000_load.t b/t-failing/070_native_traits/000_load.t new file mode 100644 index 0000000..96880cb --- /dev/null +++ b/t-failing/070_native_traits/000_load.t @@ -0,0 +1,23 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; +$TODO = q{Mouse is not yet completed}; +use Mouse (); + +BEGIN { + use_ok('Mouse::Meta::Attribute::Native'); + use_ok('Mouse::Meta::Attribute::Native::Trait::Bool'); + use_ok('Mouse::Meta::Attribute::Native::Trait::Hash'); + use_ok('Mouse::Meta::Attribute::Native::Trait::Array'); + use_ok('Mouse::Meta::Attribute::Native::Trait::Counter'); + use_ok('Mouse::Meta::Attribute::Native::Trait::Number'); + use_ok('Mouse::Meta::Attribute::Native::Trait::String'); +} + +done_testing; diff --git a/t-failing/070_native_traits/204_trait_number.t b/t-failing/070_native_traits/204_trait_number.t new file mode 100644 index 0000000..c40757e --- /dev/null +++ b/t-failing/070_native_traits/204_trait_number.t @@ -0,0 +1,117 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; +$TODO = q{Mouse is not yet completed}; +use Test::Mouse; + +{ + package Real; + use Mouse; + + has 'integer' => ( + traits => ['Number'], + is => 'ro', + isa => 'Int', + default => 5, + handles => { + set => 'set', + add => 'add', + sub => 'sub', + mul => 'mul', + div => 'div', + mod => 'mod', + abs => 'abs', + inc => [ add => 1 ], + dec => [ sub => 1 ], + odd => [ mod => 2 ], + cut_in_half => [ div => 2 ], + + }, + ); +} + +my $real = Real->new; +isa_ok( $real, 'Real' ); + +can_ok( $real, $_ ) for qw[ + set add sub mul div mod abs inc dec odd cut_in_half +]; + +is $real->integer, 5, 'Default to five'; + +$real->add(10); + +is $real->integer, 15, 'Add ten for fithteen'; + +$real->sub(3); + +is $real->integer, 12, 'Subtract three for 12'; + +$real->set(10); + +is $real->integer, 10, 'Set to ten'; + +$real->div(2); + +is $real->integer, 5, 'divide by 2'; + +$real->mul(2); + +is $real->integer, 10, 'multiplied by 2'; + +$real->mod(2); + +is $real->integer, 0, 'Mod by 2'; + +$real->set(7); + +$real->mod(5); + +is $real->integer, 2, 'Mod by 5'; + +$real->set(-1); + +$real->abs; + +is $real->integer, 1, 'abs 1'; + +$real->set(12); + +$real->inc; + +is $real->integer, 13, 'inc 12'; + +$real->dec; + +is $real->integer, 12, 'dec 13'; + +## test the meta + +my $attr = $real->meta->get_attribute('integer'); +does_ok( $attr, 'Mouse::Meta::Attribute::Native::Trait::Number' ); + +is_deeply( + $attr->handles, + { + set => 'set', + add => 'add', + sub => 'sub', + mul => 'mul', + div => 'div', + mod => 'mod', + abs => 'abs', + inc => [ add => 1 ], + dec => [ sub => 1 ], + odd => [ mod => 2 ], + cut_in_half => [ div => 2 ], + }, + '... got the right handles mapping' +); + +done_testing; diff --git a/t-failing/070_native_traits/205_trait_list.t b/t-failing/070_native_traits/205_trait_list.t new file mode 100644 index 0000000..1a58502 --- /dev/null +++ b/t-failing/070_native_traits/205_trait_list.t @@ -0,0 +1,172 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; +$TODO = q{Mouse is not yet completed}; +use Test::Exception; +use Test::Mouse 'does_ok'; + +my $sort; +my $less; +my $up; +my $prod; +{ + package Stuff; + use Mouse; + + has '_options' => ( + traits => ['Array'], + is => 'ro', + isa => 'ArrayRef[Int]', + init_arg => 'options', + default => sub { [] }, + handles => { + 'num_options' => 'count', + 'has_no_options' => 'is_empty', + 'map_options', => 'map', + 'filter_options' => 'grep', + 'find_option' => 'first', + 'options' => 'elements', + 'join_options' => 'join', + 'get_option_at' => 'get', + 'sorted_options' => 'sort', + 'randomized_options' => 'shuffle', + 'unique_options' => 'uniq', + 'less_than_five' => [ grep => ($less = sub { $_ < 5 }) ], + 'up_by_one' => [ map => ($up = sub { $_ + 1 }) ], + 'pairwise_options' => [ natatime => 2 ], + 'dashify' => [ join => '-' ], + 'descending' => [ sort => ($sort = sub { $_[1] <=> $_[0] }) ], + 'product' => [ reduce => ($prod = sub { $_[0] * $_[1] }) ], + }, + ); + +} + +my $stuff = Stuff->new( options => [ 1 .. 10 ] ); +isa_ok( $stuff, 'Stuff' ); + +can_ok( $stuff, $_ ) for qw[ + _options + num_options + has_no_options + map_options + filter_options + find_option + options + join_options + get_option_at + sorted_options + randomized_options + unique_options + less_than_five + up_by_one + pairwise_options + dashify + descending + product +]; + +is_deeply( $stuff->_options, [ 1 .. 10 ], '... got options' ); + +ok( !$stuff->has_no_options, '... we have options' ); +is( $stuff->num_options, 10, '... got 2 options' ); +cmp_ok( $stuff->get_option_at(0), '==', 1, '... get option 0' ); + +is_deeply( + [ $stuff->filter_options( sub { $_ % 2 == 0 } ) ], + [ 2, 4, 6, 8, 10 ], + '... got the right filtered values' +); + +is_deeply( + [ $stuff->map_options( sub { $_ * 2 } ) ], + [ 2, 4, 6, 8, 10, 12, 14, 16, 18, 20 ], + '... got the right mapped values' +); + +is( $stuff->find_option( sub { $_ % 2 == 0 } ), 2, + '.. found the right option' ); + +is_deeply( [ $stuff->options ], [ 1 .. 10 ], '... got the list of options' ); + +is( $stuff->join_options(':'), '1:2:3:4:5:6:7:8:9:10', + '... joined the list of options by :' ); + +is_deeply( + [ $stuff->sorted_options ], [ sort ( 1 .. 10 ) ], + '... got sorted options (default sort order)' +); +is_deeply( + [ $stuff->sorted_options( sub { $_[1] <=> $_[0] } ) ], + [ sort { $b <=> $a } ( 1 .. 10 ) ], + '... got sorted options (descending sort order) ' +); + +throws_ok { $stuff->sorted_options('foo') } +qr/Argument must be a code reference/, + 'error when sort receives a non-coderef argument'; + +is_deeply( [ sort { $a <=> $b } $stuff->randomized_options ], [ 1 .. 10 ] ); + +my @pairs; +$stuff->pairwise_options(sub { push @pairs, [@_] }); +is_deeply( \@pairs, [ [ 1, 2 ], [ 3, 4 ], [ 5, 6 ], [ 7, 8 ], [ 9, 10 ] ] ); + +# test the currying +is_deeply( [ $stuff->less_than_five() ], [ 1 .. 4 ] ); + +is_deeply( [ $stuff->up_by_one() ], [ 2 .. 11 ] ); + +is( $stuff->dashify, '1-2-3-4-5-6-7-8-9-10' ); + +is_deeply( [ $stuff->descending ], [ reverse 1 .. 10 ] ); + +is( $stuff->product, 3628800 ); + +my $other_stuff = Stuff->new( options => [ 1, 1, 2, 3, 5 ] ); +is_deeply( [ $other_stuff->unique_options ], [1, 2, 3, 5] ); + +## test the meta + +my $options = $stuff->meta->get_attribute('_options'); +does_ok( $options, 'Mouse::Meta::Attribute::Native::Trait::Array' ); + +is_deeply( + $options->handles, + { + 'num_options' => 'count', + 'has_no_options' => 'is_empty', + 'map_options', => 'map', + 'filter_options' => 'grep', + 'find_option' => 'first', + 'options' => 'elements', + 'join_options' => 'join', + 'get_option_at' => 'get', + 'sorted_options' => 'sort', + 'randomized_options' => 'shuffle', + 'unique_options' => 'uniq', + 'less_than_five' => [ grep => $less ], + 'up_by_one' => [ map => $up ], + 'pairwise_options' => [ natatime => 2 ], + 'dashify' => [ join => '-' ], + 'descending' => [ sort => $sort ], + 'product' => [ reduce => $prod ], + }, + '... got the right handles mapping' +); + +is( $options->type_constraint->type_parameter, 'Int', + '... got the right container type' ); + +dies_ok { + $stuff->sort_in_place_options(undef); +} +'... sort rejects arg of invalid type'; + +done_testing; diff --git a/t/100_bugs/failing/006_handles_foreign_class_bug.t b/t-failing/100_bugs/006_handles_foreign_class_bug.t similarity index 89% rename from t/100_bugs/failing/006_handles_foreign_class_bug.t rename to t-failing/100_bugs/006_handles_foreign_class_bug.t index c48d9d5..53804cf 100644 --- a/t/100_bugs/failing/006_handles_foreign_class_bug.t +++ b/t-failing/100_bugs/006_handles_foreign_class_bug.t @@ -1,9 +1,13 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 15; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; { @@ -108,4 +112,4 @@ isa_ok($blart, 'Blart'); is($blart->a, 'Foo::a', '... got the right delgated value'); - +done_testing; diff --git a/t/100_bugs/failing/018_immutable_metaclass_does_role.t b/t-failing/100_bugs/018_immutable_metaclass_does_role.t similarity index 90% rename from t/100_bugs/failing/018_immutable_metaclass_does_role.t rename to t-failing/100_bugs/018_immutable_metaclass_does_role.t index 4f4b03f..0766b6a 100644 --- a/t/100_bugs/failing/018_immutable_metaclass_does_role.t +++ b/t-failing/100_bugs/018_immutable_metaclass_does_role.t @@ -1,13 +1,16 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 36; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; - BEGIN { package MyRole; use Mouse::Role; @@ -68,7 +71,7 @@ is( MyClass->meta->foo, 'i am foo', '... foo method returns expected value' ); lives_ok { MyMetaclass->meta->make_immutable; -} '... make MyClass immutable okay'; +} '... make MyMetaclass immutable okay'; is(MyClass->meta, $mc, '... these metas are still the same thing'); is(MyClass->meta->meta, $mc->meta, '... these meta-metas are the same thing'); @@ -80,7 +83,7 @@ is( MyClass->meta->foo, 'i am foo', '... foo method returns expected value' ); lives_ok { MyClass->meta->make_immutable; -} '... make MyClass immutable okay'; +} '... make MyClass immutable (again) okay'; is(MyClass->meta, $mc, '... these metas are still the same thing'); is(MyClass->meta->meta, $mc->meta, '... these meta-metas are the same thing'); @@ -90,3 +93,4 @@ is( $a->meta->foo, 'i am foo', '... foo method returns expected value' ); ok( MyClass->meta->meta->does_role('MyRole'), 'metaclass does MyRole' ); is( MyClass->meta->foo, 'i am foo', '... foo method returns expected value' ); +done_testing; diff --git a/t/100_bugs/failing/023_DEMOLISH_fails_without_metaclass.t b/t-failing/100_bugs/023_DEMOLISH_fails_without_metaclass.t similarity index 66% rename from t/100_bugs/failing/023_DEMOLISH_fails_without_metaclass.t rename to t-failing/100_bugs/023_DEMOLISH_fails_without_metaclass.t index a038456..1bd625b 100644 --- a/t/100_bugs/failing/023_DEMOLISH_fails_without_metaclass.t +++ b/t-failing/100_bugs/023_DEMOLISH_fails_without_metaclass.t @@ -1,7 +1,11 @@ use strict; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use warnings; -use Test::More tests => 2; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; { @@ -16,19 +20,21 @@ my $object = MyClass->new; # Removing the metaclass simulates the case where the metaclass object # goes out of scope _before_ the object itself, which under normal # circumstances only happens during global destruction. -Class::MOP::remove_metaclass_by_name('MyClass'); +Mouse::Util::remove_metaclass_by_name('MyClass'); # The bug happened when DEMOLISHALL called -# Class::MOP::class_of($object) and did not get a metaclass object +# Mouse::Util::class_of($object) and did not get a metaclass object # back. lives_ok { $object->DESTROY } 'can call DESTROY on an object without a metaclass object in the CMOP cache'; MyClass->meta->make_immutable; -Class::MOP::remove_metaclass_by_name('MyClass'); +Mouse::Util::remove_metaclass_by_name('MyClass'); # The bug didn't manifest for immutable objects, but this test should # help us prevent it happening in the future. lives_ok { $object->DESTROY } 'can call DESTROY on an object without a metaclass object in the CMOP cache (immutable version)'; + +done_testing; diff --git a/t/100_bugs/failing/024_anon_method_metaclass.t b/t-failing/100_bugs/024_anon_method_metaclass.t similarity index 84% rename from t/100_bugs/failing/024_anon_method_metaclass.t rename to t-failing/100_bugs/024_anon_method_metaclass.t index e8f639b..2977c6f 100644 --- a/t/100_bugs/failing/024_anon_method_metaclass.t +++ b/t-failing/100_bugs/024_anon_method_metaclass.t @@ -1,6 +1,10 @@ use strict; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use warnings; -use Test::More tests => 10; +use Test::More; +$TODO = q{Mouse is not yet completed}; { package Ball; @@ -46,3 +50,5 @@ for ( 1, 2 ) { undef $method_meta; } + +done_testing; diff --git a/t-failing/200_examples/006_example_Protomoose.t b/t-failing/200_examples/006_example_Protomoose.t new file mode 100644 index 0000000..e33167c --- /dev/null +++ b/t-failing/200_examples/006_example_Protomoose.t @@ -0,0 +1,287 @@ +#!/usr/local/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; +$TODO = q{Mouse is not yet completed}; + +=pod + +This is an example of making Mouse behave +more like a prototype based object system. + +Why? + +Well cause merlyn asked if it could :) + +=cut + +## ------------------------------------------------------------------ +## make some metaclasses + +{ + package ProtoMoose::Meta::Instance; + use Mouse; + + BEGIN { extends 'Mouse::Meta::Instance' }; + + # NOTE: + # do not let things be inlined by + # the attribute or accessor generator + sub is_inlinable { 0 } +} + +{ + package ProtoMoose::Meta::Method::Accessor; + use Mouse; + + BEGIN { extends 'Mouse::Meta::Method' }; + + # customize the accessors to always grab + # the correct instance in the accessors + + sub find_instance { + my ($self, $candidate, $accessor_type) = @_; + + my $instance = $candidate; + my $attr = $self->associated_attribute; + + # if it is a class calling it ... + unless (blessed($instance)) { + # then grab the class prototype + $instance = $attr->associated_class->prototype_instance; + } + # if its an instance ... + else { + # and there is no value currently + # associated with the instance and + # we are trying to read it, then ... + if ($accessor_type eq 'r' && !defined($attr->get_value($instance))) { + # again, defer the prototype in + # the class in which is was defined + $instance = $attr->associated_class->prototype_instance; + } + # otherwise, you want to assign + # to your local copy ... + } + return $instance; + } + + sub _generate_accessor_method { + my $self = shift; + my $attr = $self->associated_attribute; + return sub { + if (scalar(@_) == 2) { + $attr->set_value( + $self->find_instance($_[0], 'w'), + $_[1] + ); + } + $attr->get_value($self->find_instance($_[0], 'r')); + }; + } + + sub _generate_reader_method { + my $self = shift; + my $attr = $self->associated_attribute; + return sub { + confess "Cannot assign a value to a read-only accessor" if @_ > 1; + $attr->get_value($self->find_instance($_[0], 'r')); + }; + } + + sub _generate_writer_method { + my $self = shift; + my $attr = $self->associated_attribute; + return sub { + $attr->set_value( + $self->find_instance($_[0], 'w'), + $_[1] + ); + }; + } + + # deal with these later ... + sub generate_predicate_method {} + sub generate_clearer_method {} + +} + +{ + package ProtoMoose::Meta::Attribute; + use Mouse; + + BEGIN { extends 'Mouse::Meta::Attribute' }; + + sub accessor_metaclass { 'ProtoMoose::Meta::Method::Accessor' } +} + +{ + package ProtoMoose::Meta::Class; + use Mouse; + + BEGIN { extends 'Mouse::Meta::Class' }; + + has 'prototype_instance' => ( + is => 'rw', + isa => 'Object', + predicate => 'has_prototypical_instance', + lazy => 1, + default => sub { (shift)->new_object } + ); + + sub initialize { + # NOTE: + # I am not sure why 'around' does + # not work here, have to investigate + # it later - SL + (shift)->SUPER::initialize(@_, + instance_metaclass => 'ProtoMoose::Meta::Instance', + attribute_metaclass => 'ProtoMoose::Meta::Attribute', + ); + } + + around 'construct_instance' => sub { + my $next = shift; + my $self = shift; + # NOTE: + # we actually have to do this here + # to tie-the-knot, if you take it + # out, then you get deep recursion + # several levels deep :) + $self->prototype_instance($next->($self, @_)) + unless $self->has_prototypical_instance; + return $self->prototype_instance; + }; + +} + +{ + package ProtoMoose::Object; + use metaclass 'ProtoMoose::Meta::Class'; + use Mouse; + + sub new { + my $prototype = blessed($_[0]) + ? $_[0] + : $_[0]->meta->prototype_instance; + my (undef, %params) = @_; + my $self = $prototype->meta->clone_object($prototype, %params); + $self->BUILDALL(\%params); + return $self; + } +} + +## ------------------------------------------------------------------ +## make some classes now + +{ + package Foo; + use Mouse; + + extends 'ProtoMoose::Object'; + + has 'bar' => (is => 'rw'); +} + +{ + package Bar; + use Mouse; + + extends 'Foo'; + + has 'baz' => (is => 'rw'); +} + +## ------------------------------------------------------------------ + +## ------------------------------------------------------------------ +## Check that metaclasses are working/inheriting properly + +foreach my $class (qw/ProtoMoose::Object Foo Bar/) { + isa_ok($class->meta, + 'ProtoMoose::Meta::Class', + '... got the right metaclass for ' . $class . ' ->'); + + is($class->meta->instance_metaclass, + 'ProtoMoose::Meta::Instance', + '... got the right instance meta for ' . $class); + + is($class->meta->attribute_metaclass, + 'ProtoMoose::Meta::Attribute', + '... got the right attribute meta for ' . $class); +} + +## ------------------------------------------------------------------ + +# get the prototype for Foo +my $foo_prototype = Foo->meta->prototype_instance; +isa_ok($foo_prototype, 'Foo'); + +# set a value in the prototype +$foo_prototype->bar(100); +is($foo_prototype->bar, 100, '... got the value stored in the prototype'); + +# the "class" defers to the +# the prototype when asked +# about attributes +is(Foo->bar, 100, '... got the value stored in the prototype (through the Foo class)'); + +# now make an instance, which +# is basically a clone of the +# prototype +my $foo = Foo->new; +isa_ok($foo, 'Foo'); + +# the instance is *not* the prototype +isnt($foo, $foo_prototype, '... got a new instance of Foo'); + +# but it has the same values ... +is($foo->bar, 100, '... got the value stored in the instance (inherited from the prototype)'); + +# we can even change the values +# in the instance +$foo->bar(300); +is($foo->bar, 300, '... got the value stored in the instance (overwriting the one inherited from the prototype)'); + +# and not change the one in the prototype +is($foo_prototype->bar, 100, '... got the value stored in the prototype'); +is(Foo->bar, 100, '... got the value stored in the prototype (through the Foo class)'); + +## subclasses + +# now we can check that the subclass +# will seek out the correct prototypical +# value from it's "parent" +is(Bar->bar, 100, '... got the value stored in the Foo prototype (through the Bar class)'); + +# we can then also set it's local attrs +Bar->baz(50); +is(Bar->baz, 50, '... got the value stored in the prototype (through the Bar class)'); + +# now we clone the Bar prototype +my $bar = Bar->new; +isa_ok($bar, 'Bar'); +isa_ok($bar, 'Foo'); + +# and we see that we got the right values +# in the instance/clone +is($bar->bar, 100, '... got the value stored in the instance (inherited from the Foo prototype)'); +is($bar->baz, 50, '... got the value stored in the instance (inherited from the Bar prototype)'); + +# nowe we can change the value +$bar->bar(200); +is($bar->bar, 200, '... got the value stored in the instance (overriding the one inherited from the Foo prototype)'); + +# and all our original and +# prototypical values are still +# the same +is($foo->bar, 300, '... still got the original value stored in the instance (inherited from the prototype)'); +is(Foo->bar, 100, '... still got the original value stored in the prototype (through the Foo class)'); +is(Bar->bar, 100, '... still got the original value stored in the prototype (through the Bar class)'); + +done_testing; diff --git a/t-failing/400_moose_util/003_moose_util_search_class_by_role.t b/t-failing/400_moose_util/003_moose_util_search_class_by_role.t new file mode 100644 index 0000000..0ab84b8 --- /dev/null +++ b/t-failing/400_moose_util/003_moose_util_search_class_by_role.t @@ -0,0 +1,49 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; +$TODO = q{Mouse is not yet completed}; + +BEGIN { + use_ok('Mouse::Util', ':all'); +} + +{ package SCBR::Role; + use Mouse::Role; +} + +{ package SCBR::A; + use Mouse; +} +is search_class_by_role('SCBR::A', 'SCBR::Role'), undef, '... not found role returns undef'; +is search_class_by_role('SCBR::A', SCBR::Role->meta), undef, '... not found role returns undef'; + +{ package SCBR::B; + use Mouse; + extends 'SCBR::A'; + with 'SCBR::Role'; +} +is search_class_by_role('SCBR::B', 'SCBR::Role'), 'SCBR::B', '... class itself returned if it does role'; +is search_class_by_role('SCBR::B', SCBR::Role->meta), 'SCBR::B', '... class itself returned if it does role'; + +{ package SCBR::C; + use Mouse; + extends 'SCBR::B'; +} +is search_class_by_role('SCBR::C', 'SCBR::Role'), 'SCBR::B', '... nearest class doing role returned'; +is search_class_by_role('SCBR::C', SCBR::Role->meta), 'SCBR::B', '... nearest class doing role returned'; + +{ package SCBR::D; + use Mouse; + extends 'SCBR::C'; + with 'SCBR::Role'; +} +is search_class_by_role('SCBR::D', 'SCBR::Role'), 'SCBR::D', '... nearest class being direct class returned'; +is search_class_by_role('SCBR::D', SCBR::Role->meta), 'SCBR::D', '... nearest class being direct class returned'; + +done_testing; diff --git a/t-failing/400_moose_util/004_resolve_alias.t b/t-failing/400_moose_util/004_resolve_alias.t new file mode 100644 index 0000000..3e5c287 --- /dev/null +++ b/t-failing/400_moose_util/004_resolve_alias.t @@ -0,0 +1,83 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; +$TODO = q{Mouse is not yet completed}; + +use Mouse::Util qw( resolve_metaclass_alias resolve_metatrait_alias ); + +use lib 't/lib'; + +# Doing each test twice is intended to make sure that the caching +# doesn't break name resolution. It doesn't actually test that +# anything is cached. +is( resolve_metaclass_alias( 'Attribute', 'Mouse::Meta::Attribute::Custom::Foo' ), + 'Mouse::Meta::Attribute::Custom::Foo', + 'resolve_metaclass_alias finds Mouse::Meta::Attribute::Custom::Foo' ); + +is( resolve_metaclass_alias( 'Attribute', 'Mouse::Meta::Attribute::Custom::Foo' ), + 'Mouse::Meta::Attribute::Custom::Foo', + 'resolve_metaclass_alias finds Mouse::Meta::Attribute::Custom::Foo second time' ); + +is( resolve_metaclass_alias( 'Attribute', 'Foo' ), + 'Mouse::Meta::Attribute::Custom::Foo', + 'resolve_metaclass_alias finds Mouse::Meta::Attribute::Custom::Foo via alias (Foo)' ); + +is( resolve_metaclass_alias( 'Attribute', 'Foo' ), + 'Mouse::Meta::Attribute::Custom::Foo', + 'resolve_metaclass_alias finds Mouse::Meta::Attribute::Custom::Foo via alias (Foo) a second time' ); + +is( resolve_metaclass_alias( 'Attribute', 'Mouse::Meta::Attribute::Custom::Bar' ), + 'My::Bar', + 'resolve_metaclass_alias finds Mouse::Meta::Attribute::Custom::Bar as My::Bar' ); + +is( resolve_metaclass_alias( 'Attribute', 'Mouse::Meta::Attribute::Custom::Bar' ), + 'My::Bar', + 'resolve_metaclass_alias finds Mouse::Meta::Attribute::Custom::Bar as My::Bar a second time' ); + +is( resolve_metaclass_alias( 'Attribute', 'Bar' ), + 'My::Bar', + 'resolve_metaclass_alias finds Mouse::Meta::Attribute::Custom::Bar as My::Bar via alias (Bar)' ); + +is( resolve_metaclass_alias( 'Attribute', 'Bar' ), + 'My::Bar', + 'resolve_metaclass_alias finds Mouse::Meta::Attribute::Custom::Bar as My::Bar via alias (Bar) a second time' ); + +is( resolve_metatrait_alias( 'Attribute', 'Mouse::Meta::Attribute::Custom::Trait::Foo' ), + 'Mouse::Meta::Attribute::Custom::Trait::Foo', + 'resolve_metatrait_alias finds Mouse::Meta::Attribute::Custom::Trait::Foo' ); + +is( resolve_metatrait_alias( 'Attribute', 'Mouse::Meta::Attribute::Custom::Trait::Foo' ), + 'Mouse::Meta::Attribute::Custom::Trait::Foo', + 'resolve_metatrait_alias finds Mouse::Meta::Attribute::Custom::Trait::Foo second time' ); + +is( resolve_metatrait_alias( 'Attribute', 'Foo' ), + 'Mouse::Meta::Attribute::Custom::Trait::Foo', + 'resolve_metatrait_alias finds Mouse::Meta::Attribute::Custom::Trait::Foo via alias (Foo)' ); + +is( resolve_metatrait_alias( 'Attribute', 'Foo' ), + 'Mouse::Meta::Attribute::Custom::Trait::Foo', + 'resolve_metatrait_alias finds Mouse::Meta::Attribute::Custom::Trait::Foo via alias (Foo) a second time' ); + +is( resolve_metatrait_alias( 'Attribute', 'Mouse::Meta::Attribute::Custom::Trait::Bar' ), + 'My::Trait::Bar', + 'resolve_metatrait_alias finds Mouse::Meta::Attribute::Custom::Trait::Bar as My::Trait::Bar' ); + +is( resolve_metatrait_alias( 'Attribute', 'Mouse::Meta::Attribute::Custom::Trait::Bar' ), + 'My::Trait::Bar', + 'resolve_metatrait_alias finds Mouse::Meta::Attribute::Custom::Trait::Bar as My::Trait::Bar a second time' ); + +is( resolve_metatrait_alias( 'Attribute', 'Bar' ), + 'My::Trait::Bar', + 'resolve_metatrait_alias finds Mouse::Meta::Attribute::Custom::Trait::Bar as My::Trait::Bar via alias (Bar)' ); + +is( resolve_metatrait_alias( 'Attribute', 'Bar' ), + 'My::Trait::Bar', + 'resolve_metatrait_alias finds Mouse::Meta::Attribute::Custom::Trait::Bar as My::Trait::Bar via alias (Bar) a second time' ); + +done_testing; diff --git a/t-failing/400_moose_util/005_ensure_all_roles.t b/t-failing/400_moose_util/005_ensure_all_roles.t new file mode 100644 index 0000000..aac2c07 --- /dev/null +++ b/t-failing/400_moose_util/005_ensure_all_roles.t @@ -0,0 +1,70 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; +$TODO = q{Mouse is not yet completed}; + +BEGIN { + use_ok('Mouse::Util', ':all'); +} + +{ + package Foo; + use Mouse::Role; +} + +{ + package Bar; + use Mouse::Role; +} + +{ + package Quux; + use Mouse; +} + +is_deeply( + Quux->meta->roles, + [], + "no roles yet", +); + +Foo->meta->apply(Quux->meta); + +is_deeply( + Quux->meta->roles, + [ Foo->meta ], + "applied Foo", +); + +Foo->meta->apply(Quux->meta); +Bar->meta->apply(Quux->meta); +is_deeply( + Quux->meta->roles, + [ Foo->meta, Foo->meta, Bar->meta ], + "duplicated Foo", +); + +is(does_role('Quux', 'Foo'), 1, "Quux does Foo"); +is(does_role('Quux', 'Bar'), 1, "Quux does Bar"); +ensure_all_roles('Quux', qw(Foo Bar)); +is_deeply( + Quux->meta->roles, + [ Foo->meta, Foo->meta, Bar->meta ], + "unchanged, since all roles are already applied", +); + +my $obj = Quux->new; +ensure_all_roles($obj, qw(Foo Bar)); +is_deeply( + $obj->meta->roles, + [ Foo->meta, Foo->meta, Bar->meta ], + "unchanged, since all roles are already applied", +); + +done_testing; diff --git a/t-failing/400_moose_util/006_create_alias.t b/t-failing/400_moose_util/006_create_alias.t new file mode 100644 index 0000000..7f0db46 --- /dev/null +++ b/t-failing/400_moose_util/006_create_alias.t @@ -0,0 +1,108 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; +$TODO = q{Mouse is not yet completed}; +use Test::Mouse qw(does_ok); + +BEGIN { + package Foo::Meta::Role; + use Mouse::Role; + Mouse::Util::meta_class_alias + FooRole => 'Foo::Meta::Role'; + + package Foo::Meta::Class; + use Mouse; + extends 'Mouse::Meta::Class'; + with 'Foo::Meta::Role'; + Mouse::Util::meta_class_alias + FooClass => 'Foo::Meta::Class'; + + package Foo::Meta::Role::Attribute; + use Mouse::Role; + Mouse::Util::meta_attribute_alias + FooAttrRole => 'Foo::Meta::Role::Attribute'; + + package Foo::Meta::Attribute; + use Mouse; + extends 'Mouse::Meta::Attribute'; + with 'Foo::Meta::Role::Attribute'; + Mouse::Util::meta_attribute_alias + FooAttrClass => 'Foo::Meta::Attribute'; + + package Bar::Meta::Role; + use Mouse::Role; + Mouse::Util::meta_class_alias 'BarRole'; + + package Bar::Meta::Class; + use Mouse; + extends 'Mouse::Meta::Class'; + with 'Bar::Meta::Role'; + Mouse::Util::meta_class_alias 'BarClass'; + + package Bar::Meta::Role::Attribute; + use Mouse::Role; + Mouse::Util::meta_attribute_alias 'BarAttrRole'; + + package Bar::Meta::Attribute; + use Mouse; + extends 'Mouse::Meta::Attribute'; + with 'Bar::Meta::Role::Attribute'; + Mouse::Util::meta_attribute_alias 'BarAttrClass'; +} + +package FooWithMetaClass; +use Mouse -metaclass => 'FooClass'; + +has bar => ( + metaclass => 'FooAttrClass', + is => 'ro', +); + + +package FooWithMetaTrait; +use Mouse -traits => 'FooRole'; + +has bar => ( + traits => [qw(FooAttrRole)], + is => 'ro', +); + +package BarWithMetaClass; +use Mouse -metaclass => 'BarClass'; + +has bar => ( + metaclass => 'BarAttrClass', + is => 'ro', +); + + +package BarWithMetaTrait; +use Mouse -traits => 'BarRole'; + +has bar => ( + traits => [qw(BarAttrRole)], + is => 'ro', +); + +package main; +my $fwmc_meta = FooWithMetaClass->meta; +my $fwmt_meta = FooWithMetaTrait->meta; +isa_ok($fwmc_meta, 'Foo::Meta::Class'); +isa_ok($fwmc_meta->get_attribute('bar'), 'Foo::Meta::Attribute'); +does_ok($fwmt_meta, 'Foo::Meta::Role'); +does_ok($fwmt_meta->get_attribute('bar'), 'Foo::Meta::Role::Attribute'); + +my $bwmc_meta = BarWithMetaClass->meta; +my $bwmt_meta = BarWithMetaTrait->meta; +isa_ok($bwmc_meta, 'Bar::Meta::Class'); +isa_ok($bwmc_meta->get_attribute('bar'), 'Bar::Meta::Attribute'); +does_ok($bwmt_meta, 'Bar::Meta::Role'); +does_ok($bwmt_meta->get_attribute('bar'), 'Bar::Meta::Role::Attribute'); + +done_testing; diff --git a/t-failing/400_moose_util/008_method_mod_args.t b/t-failing/400_moose_util/008_method_mod_args.t new file mode 100644 index 0000000..5942f44 --- /dev/null +++ b/t-failing/400_moose_util/008_method_mod_args.t @@ -0,0 +1,35 @@ +use strict; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use warnings; + +use Test::More; +$TODO = q{Mouse is not yet completed}; +use Test::Exception; +use Mouse::Util qw( add_method_modifier ); + +my $COUNT = 0; +{ + package Foo; + use Mouse; + + sub foo { } + sub bar { } +} + +lives_ok { + add_method_modifier('Foo', 'before', [ ['foo', 'bar'], sub { $COUNT++ } ]); +} 'method modifier with an arrayref'; + +dies_ok { + add_method_modifier('Foo', 'before', [ {'foo' => 'bar'}, sub { $COUNT++ } ]); +} 'method modifier with a hashref'; + +my $foo = Foo->new; +$foo->foo; +$foo->bar; +is($COUNT, 2, "checking that the modifiers were installed."); + + +done_testing; diff --git a/t-failing/400_moose_util/009_with_traits.t b/t-failing/400_moose_util/009_with_traits.t new file mode 100644 index 0000000..e8d1244 --- /dev/null +++ b/t-failing/400_moose_util/009_with_traits.t @@ -0,0 +1,55 @@ +#!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use strict; +use warnings; +use Test::More; +$TODO = q{Mouse is not yet completed}; +use Test::Mouse; + +use Mouse (); +use Mouse::Util qw(with_traits); + +{ + package Foo; + use Mouse; +} + +{ + package Foo::Role; + use Mouse::Role; +} + +{ + package Foo::Role2; + use Mouse::Role; +} + +{ + my $traited_class = with_traits('Foo', 'Foo::Role'); + ok($traited_class->meta->is_anon_class, "we get an anon class"); + isa_ok($traited_class, 'Foo'); + does_ok($traited_class, 'Foo::Role'); +} + +{ + my $traited_class = with_traits('Foo', 'Foo::Role', 'Foo::Role2'); + ok($traited_class->meta->is_anon_class, "we get an anon class"); + isa_ok($traited_class, 'Foo'); + does_ok($traited_class, 'Foo::Role'); + does_ok($traited_class, 'Foo::Role2'); +} + +{ + my $traited_class = with_traits('Foo'); + is($traited_class, 'Foo', "don't apply anything if we don't get any traits"); +} + +{ + my $traited_class = with_traits('Foo', 'Foo::Role'); + my $traited_class2 = with_traits('Foo', 'Foo::Role'); + is($traited_class, $traited_class2, "get the same class back when passing the same roles"); +} + +done_testing; diff --git a/t-failing/600_todo_tests/002_various_role_features.t b/t-failing/600_todo_tests/002_various_role_features.t new file mode 100644 index 0000000..a8afc95 --- /dev/null +++ b/t-failing/600_todo_tests/002_various_role_features.t @@ -0,0 +1,279 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; +$TODO = q{Mouse is not yet completed}; +use Test::Exception; + +sub req_or_has ($$) { + my ( $role, $method ) = @_; + local $Test::Builder::Level = $Test::Builder::Level + 1; + if ( $role ) { + ok( + $role->has_method($method) || $role->requires_method($method), + $role->name . " has or requires method $method" + ); + } else { + fail("role has or requires method $method"); + } +} + +{ + package Bar; + use Mouse::Role; + + # this role eventually adds three methods, qw(foo bar xxy), but only one is + # known when it's still a role + + has foo => ( is => "rw" ); + + has gorch => ( reader => "bar" ); + + sub xxy { "BAAAD" } + + package Gorch; + use Mouse::Role; + + # similarly this role gives attr and gorch_method + + has attr => ( is => "rw" ); + + sub gorch_method { "gorch method" } + + around dandy => sub { shift->(@_) . "bar" }; + + package Quxx; + use Mouse; + + sub dandy { "foo" } + + # this object will be used in an attr of Foo to test that Foo can do the + # Gorch interface + + with qw(Gorch); + + package Dancer; + use Mouse::Role; + + requires "twist"; + + package Dancer::Ballerina; + use Mouse; + + with qw(Dancer); + + sub twist { } + + sub pirouette { } + + package Dancer::Robot; + use Mouse::Role; + + # this doesn't fail but it produces a requires in the role + # the order doesn't matter + has twist => ( is => "rw" ); + ::lives_ok { with qw(Dancer) }; + + package Dancer::Something; + use Mouse; + + # this fail even though the method already exists + + has twist => ( is => "rw" ); + + { + ::lives_ok { with qw(Dancer) }; + } + + package Dancer::80s; + use Mouse; + + # this should pass because ::Robot has the attribute to fill in the requires + # but due to the deferrence logic that doesn't actually work + { + local our $TODO = "attribute accessor in role doesn't satisfy role requires"; + ::lives_ok { with qw(Dancer::Robot) }; + } + + package Foo; + use Mouse; + + with qw(Bar); + + has oink => ( + is => "rw", + handles => "Gorch", # should handles take the same arguments as 'with'? Meta::Role::Application::Delegation? + default => sub { Quxx->new }, + ); + + has dancer => ( + is => "rw", + does => "Dancer", + handles => "Dancer", + default => sub { Dancer::Ballerina->new }, + ); + + sub foo { 42 } + + sub bar { 33 } + + sub xxy { 7 } + + package Tree; + use Mouse::Role; + + has bark => ( is => "rw" ); + + package Dog; + use Mouse::Role; + + sub bark { warn "woof!" }; + + package EntPuppy; + use Mouse; + + { + local our $TODO = "attrs and methods from a role should clash"; + ::dies_ok { with qw(Tree Dog) } + } +} + +# these fail because of the deferral logic winning over actual methods +# this might be tricky to fix due to the 'sub foo {}; has foo => ( )' hack +# we've been doing for a long while, though I doubt people relied on it for +# anything other than fulfilling 'requires' +{ + local $TODO = "attributes from role overwrite class methods"; + is( Foo->new->foo, 42, "attr did not zap overriding method" ); + is( Foo->new->bar, 33, "attr did not zap overriding method" ); +} +is( Foo->new->xxy, 7, "method did not zap overriding method" ); # duh + +# these pass, simple delegate +# mostly they are here to contrast the next blck +can_ok( Foo->new->oink, "dandy" ); +can_ok( Foo->new->oink, "attr" ); +can_ok( Foo->new->oink, "gorch_method" ); + +ok( Foo->new->oink->does("Gorch"), "Quxx does Gorch" ); + + +# these are broken because 'attr' is not technically part of the interface +can_ok( Foo->new, "gorch_method" ); +{ + local $TODO = "accessor methods from a role are omitted in handles role"; + can_ok( Foo->new, "attr" ); +} + +{ + local $TODO = "handles role doesn't add the role to the ->does of the delegate's parent class"; + ok( Foo->new->does("Gorch"), "Foo does Gorch" ); +} + + +# these work +can_ok( Foo->new->dancer, "pirouette" ); +can_ok( Foo->new->dancer, "twist" ); + +can_ok( Foo->new, "twist" ); +ok( !Foo->new->can("pirouette"), "can't pirouette, not part of the iface" ); + +{ + local $TODO = "handles role doesn't add the role to the ->does of the delegate's parent class"; + ok( Foo->new->does("Dancer") ); +} + + + + +my $gorch = Gorch->meta; + +isa_ok( $gorch, "Mouse::Meta::Role" ); + +ok( $gorch->has_attribute("attr"), "has attribute 'attr'" ); +isa_ok( $gorch->get_attribute("attr"), "Mouse::Meta::Role::Attribute" ); + +req_or_has($gorch, "gorch_method"); +ok( $gorch->has_method("gorch_method"), "has_method gorch_method" ); +ok( !$gorch->requires_method("gorch_method"), "requires gorch method" ); +isa_ok( $gorch->get_method("gorch_method"), "Mouse::Meta::Method" ); + +{ + local $TODO = "method modifier doesn't yet create a method requirement or meta object"; + req_or_has($gorch, "dandy" ); + + # this specific test is maybe not backwards compat, but in theory it *does* + # require that method to exist + ok( $gorch->requires_method("dandy"), "requires the dandy method for the modifier" ); +} + +{ + local $TODO = "attribute related methods are not yet known by the role"; + # we want this to be a part of the interface, somehow + req_or_has($gorch, "attr"); + ok( $gorch->has_method("attr"), "has_method attr" ); + isa_ok( $gorch->get_method("attr"), "Mouse::Meta::Method" ); + isa_ok( $gorch->get_method("attr"), "Mouse::Meta::Method" ); +} + +my $robot = Dancer::Robot->meta; + +isa_ok( $robot, "Mouse::Meta::Role" ); + +ok( $robot->has_attribute("twist"), "has attr 'twist'" ); +isa_ok( $robot->get_attribute("twist"), "Mouse::Meta::Role::Attribute" ); + +{ + req_or_has($robot, "twist"); + + local $TODO = "attribute related methods are not yet known by the role"; + ok( $robot->has_method("twist"), "has twist method" ); + isa_ok( $robot->get_method("twist"), "Mouse::Meta::Method" ); + isa_ok( $robot->get_method("twist"), "Mouse::Meta::Method" ); +} + +done_testing; + +__END__ + +I think Attribute needs to be refactored in some way to better support roles. + +There are several possible ways to do this, all of them seem plausible to me. + +The first approach would be to change the attribute class to allow it to be +queried about the methods it would install. + +Then we instantiate the attribute in the role, and instead of deferring the +arguments, we just make an Cish method. + +Then we can interrogate the attr when adding it to the role, and generate stub +methods for all the methods it would produce. + +A second approach is kinda like the Immutable hack: wrap the attr in an +anonmyous class that disables part of its interface. + +A third method would be to create an Attribute::Partial object that would +provide a more role-ish behavior, and to do this independently of the actual +Attribute class. + +Something similar can be done for method modifiers, but I think that's even simpler. + + + +The benefits of doing this are: + +* Much better introspection of roles + +* More correctness in many cases (in my opinion anyway) + +* More roles are more usable as interface declarations, without having to split + them into two pieces (one for the interface with a bunch of requires(), and + another for the actual impl with the problematic attrs (and stub methods to + fix the accessors) and method modifiers (dunno if this can even work at all) + + diff --git a/t-failing/600_todo_tests/004_role_insertion_order.t b/t-failing/600_todo_tests/004_role_insertion_order.t new file mode 100644 index 0000000..7be8d3c --- /dev/null +++ b/t-failing/600_todo_tests/004_role_insertion_order.t @@ -0,0 +1,46 @@ +#!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use strict; +use warnings; +use Test::More; +$TODO = q{Mouse is not yet completed}; + +{ + package Foo::Role; + use Mouse::Role; + has 'a' => (is => 'ro'); + has 'b' => (is => 'ro'); + has 'c' => (is => 'ro'); +} + +{ + package Foo; + use Mouse; + has 'd' => (is => 'ro'); + with 'Foo::Role'; + has 'e' => (is => 'ro'); +} + +my %role_insertion_order = ( + a => 0, + b => 1, + c => 2, +); + +is_deeply({ map { $_->name => $_->insertion_order } map { Foo::Role->meta->get_attribute($_) } Foo::Role->meta->get_attribute_list }, \%role_insertion_order, "right insertion order within the role"); + +my %class_insertion_order = ( + d => 0, + a => 1, + b => 2, + c => 3, + e => 4, +); + +{ local $TODO = "insertion order is lost during role application"; +is_deeply({ map { $_->name => $_->insertion_order } Foo->meta->get_all_attributes }, \%class_insertion_order, "right insertion order within the class"); +} + +done_testing; diff --git a/t/000_load.t b/t/000_load.t new file mode 100644 index 0000000..eeb9f2d --- /dev/null +++ b/t/000_load.t @@ -0,0 +1,19 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; + +{ + package Foo; + + # Mouse will issue a warning if we try to load it from the main + # package. + ::use_ok('Mouse'); +} + +done_testing; diff --git a/t/000_recipes/basics-recipe10.t b/t/000_recipes/basics-recipe10.t index 530ff0b..93f8e7e 100644 --- a/t/000_recipes/basics-recipe10.t +++ b/t/000_recipes/basics-recipe10.t @@ -1,11 +1,12 @@ #!/usr/bin/perl - -# This test is taken from Moose :) +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 10; +use Test::More; { @@ -45,15 +46,7 @@ use Test::More tests => 10; ); } - # use List::MoreUtils 'zip' - # code taken from List::MoreUtils - sub zip (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) { - my $max = -1; - $max < $#$_ && ( $max = $#$_ ) for @_; - - map { my $ix = $_; map $_->[$ix], @_; } 0 .. $max; - } - + use List::MoreUtils qw( zip ); coerce 'Human::EyeColor' => from 'ArrayRef' @@ -228,3 +221,4 @@ foreach my $set (@$parent_sets) { # AUTHOR: Aran Clary Deltac +done_testing; diff --git a/t/000-load.t b/t/001_status.t similarity index 100% rename from t/000-load.t rename to t/001_status.t diff --git a/t/010_basics/001_basic_class_setup.t b/t/010_basics/001_basic_class_setup.t index 348d41a..dddf676 100644 --- a/t/010_basics/001_basic_class_setup.t +++ b/t/010_basics/001_basic_class_setup.t @@ -1,13 +1,15 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 29; +use Test::More; use Test::Exception; - { package Foo; use Mouse; @@ -49,3 +51,5 @@ foreach my $import (qw( local $TODO = $import eq 'blessed' ? "no automatic namespace cleaning yet" : undef; ok(!Foo->can($import), "no namespace pollution in Mouse::Object ($import)" ); } + +done_testing; diff --git a/t/010_basics/002_require_superclasses.t b/t/010_basics/002_require_superclasses.t deleted file mode 100644 index da4776a..0000000 --- a/t/010_basics/002_require_superclasses.t +++ /dev/null @@ -1,47 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; - -use lib 't/lib', 'lib'; - -use Test::More tests => 4; -use Test::Exception; - - - -{ - - package Bar; - use Mouse; - - ::lives_ok { extends 'Foo' } 'loaded Foo superclass correctly'; -} - -{ - - package Baz; - use Mouse; - - ::lives_ok { extends 'Bar' } 'loaded (inline) Bar superclass correctly'; -} - -{ - - package Foo::Bar; - use Mouse; - - ::lives_ok { extends 'Foo', 'Bar' } - 'loaded Foo and (inline) Bar superclass correctly'; -} - -{ - - package Bling; - use Mouse; - - ::throws_ok { extends 'No::Class' } - qr{Can't locate No/Class\.pm in \@INC}, - 'correct error when superclass could not be found'; -} - diff --git a/t/010_basics/003_super_and_override.t b/t/010_basics/003_super_and_override.t index 600d5db..d68fc0d 100644 --- a/t/010_basics/003_super_and_override.t +++ b/t/010_basics/003_super_and_override.t @@ -1,13 +1,15 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 16; +use Test::More; use Test::Exception; - { package Foo; use Mouse; @@ -79,3 +81,4 @@ is($foo->baz(), 'Foo::baz', '... got the right value from &baz'); } +done_testing; diff --git a/t/010_basics/004_inner_and_augment.t b/t/010_basics/004_inner_and_augment.t index 14c4de1..29f3a80 100644 --- a/t/010_basics/004_inner_and_augment.t +++ b/t/010_basics/004_inner_and_augment.t @@ -1,13 +1,15 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 16; +use Test::More; use Test::Exception; - { package Foo; use Mouse; @@ -84,3 +86,4 @@ is($foo->baz(), 'Foo::baz()', '... got the right value from &baz'); } +done_testing; diff --git a/t/010_basics/005_override_augment_inner_super.t b/t/010_basics/005_override_augment_inner_super.t index c7ae92a..ccad403 100644 --- a/t/010_basics/005_override_augment_inner_super.t +++ b/t/010_basics/005_override_augment_inner_super.t @@ -1,10 +1,13 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 5; - +use Test::More; +$TODO = q{Mouse is not yet completed}; { @@ -65,9 +68,8 @@ Confusing I know, but it is correct :) =cut -{ - local $TODO = 'mixed augment/override is not supported'; - is($baz->bar, - 'Bar::bar -> Foo::bar(Baz::bar)', - '... got the right value from mixed augment/override bar'); -} +is($baz->bar, + 'Bar::bar -> Foo::bar(Baz::bar)', + '... got the right value from mixed augment/override bar'); + +done_testing; diff --git a/t/010_basics/006_override_and_foreign_classes.t b/t/010_basics/006_override_and_foreign_classes.t index 043d733..dadb504 100644 --- a/t/010_basics/006_override_and_foreign_classes.t +++ b/t/010_basics/006_override_and_foreign_classes.t @@ -1,10 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 15; - +use Test::More; =pod @@ -70,4 +72,6 @@ isa_ok($foo, 'Foo'); is($foo->foo(), 'Foo::foo', '... got the right value from &foo'); is($foo->bar(), 'Foo::bar', '... got the right value from &bar'); -is($foo->baz(), 'Foo::baz', '... got the right value from &baz'); \ No newline at end of file +is($foo->baz(), 'Foo::baz', '... got the right value from &baz'); + +done_testing; diff --git a/t/010_basics/007_always_strict_warnings.t b/t/010_basics/007_always_strict_warnings.t index 0c65f9e..afce556 100644 --- a/t/010_basics/007_always_strict_warnings.t +++ b/t/010_basics/007_always_strict_warnings.t @@ -1,6 +1,9 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; -use Test::More tests => 15; +use Test::More; # for classes ... { @@ -67,3 +70,5 @@ use Test::More tests => 15; ::like($warn, qr/Argument \"hello\" isn\'t numeric in addition \(\+\)/, '.. and it is the right warning'); } } + +done_testing; diff --git a/t/010_basics/008_wrapped_method_cxt_propagation.t b/t/010_basics/008_wrapped_method_cxt_propagation.t index 664b187..70a0623 100644 --- a/t/010_basics/008_wrapped_method_cxt_propagation.t +++ b/t/010_basics/008_wrapped_method_cxt_propagation.t @@ -1,10 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 7; - +use Test::More; { @@ -56,3 +58,4 @@ foreach my $obj ( $base, $after ) { } } +done_testing; diff --git a/t/010_basics/009_import_unimport.t b/t/010_basics/009_import_unimport.t index 61c6ea8..9e7ff9e 100644 --- a/t/010_basics/009_import_unimport.t +++ b/t/010_basics/009_import_unimport.t @@ -1,9 +1,13 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 40; +use Test::More; +$TODO = q{Mouse is not yet completed}; my @moose_exports = qw( @@ -13,6 +17,7 @@ my @moose_exports = qw( override augment super inner + blessed confess ); { @@ -58,7 +63,18 @@ can_ok('Bar', $_) for @moose_type_constraint_exports; die $@ if $@; } - ok(!Bar->can($_), '... Bar can no longer do ' . $_) for @moose_type_constraint_exports; +{ + package Baz; + + use Mouse; + use Scalar::Util qw( blessed ); + + no Mouse; +} + +can_ok( 'Baz', 'blessed' ); + +done_testing; diff --git a/t/010_basics/010_method_modifier_with_regexp.t b/t/010_basics/010_method_modifier_with_regexp.t index 786b8c3..9760542 100644 --- a/t/010_basics/010_method_modifier_with_regexp.t +++ b/t/010_basics/010_method_modifier_with_regexp.t @@ -1,11 +1,15 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 9; +use Test::More; use Test::Exception; + { package Dog; @@ -82,3 +86,4 @@ is( $Cat::AFTER_BARK_COUNTER, 2, 'after modifier is called twice' ); } +done_testing; diff --git a/t/010_basics/011_moose_respects_type_constraints.t b/t/010_basics/011_moose_respects_type_constraints.t index f5193f0..ed12857 100644 --- a/t/010_basics/011_moose_respects_type_constraints.t +++ b/t/010_basics/011_moose_respects_type_constraints.t @@ -1,9 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 7; +use Test::More; use Test::Exception; use Mouse::Util::TypeConstraints; @@ -58,5 +61,4 @@ dies_ok { $bar->foo(Foo->new); } '... checked the type constraint correctly'; - - +done_testing; diff --git a/t/010_basics/013_create.t b/t/010_basics/013_create.t index 1d1d28f..cd933d5 100644 --- a/t/010_basics/013_create.t +++ b/t/010_basics/013_create.t @@ -1,9 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 7; +use Test::More; use Test::Exception; { @@ -46,7 +49,7 @@ throws_ok { ); } qr/You must pass an ARRAY ref of roles/; -ok !Mouse::Util::is_class_loaded('Made::Of::Fail'), "did not create Made::Of::Fail"; +ok !Made::Of::Fail->isa('UNIVERSAL'), "did not create Made::Of::Fail"; dies_ok { Mouse::Meta::Class->create( @@ -58,3 +61,4 @@ dies_ok { # XXX: Continuing::To::Fail gets created anyway +done_testing; diff --git a/t/010_basics/014_create_anon.t b/t/010_basics/014_create_anon.t index abae25e..78e71d3 100644 --- a/t/010_basics/014_create_anon.t +++ b/t/010_basics/014_create_anon.t @@ -1,4 +1,7 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; diff --git a/t/010_basics/015_buildargs.t b/t/010_basics/015_buildargs.t index 4b9b1f3..e2cdbd4 100644 --- a/t/010_basics/015_buildargs.t +++ b/t/010_basics/015_buildargs.t @@ -1,9 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 14; +use Test::More; { package Foo; @@ -40,4 +43,4 @@ foreach my $class qw(Foo Bar) { } } - +done_testing; diff --git a/t/010_basics/016_load_into_main.t b/t/010_basics/016_load_into_main.t new file mode 100644 index 0000000..6e8de44 --- /dev/null +++ b/t/010_basics/016_load_into_main.t @@ -0,0 +1,21 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; +use Test::Exception; + +lives_ok { + eval 'use Mouse'; +} "export to main"; + +isa_ok( main->meta, "Mouse::Meta::Class" ); + +isa_ok( main->new, "main"); +isa_ok( main->new, "Mouse::Object" ); + +done_testing; diff --git a/t/010_basics/017_error_handling.t b/t/010_basics/017_error_handling.t index fee2964..0b6cb88 100644 --- a/t/010_basics/017_error_handling.t +++ b/t/010_basics/017_error_handling.t @@ -1,9 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 3; +use Test::More; use Test::Exception; # This tests the error handling in Mouse::Object only @@ -20,3 +23,5 @@ throws_ok { Foo->new(undef) } qr/^\QSingle parameters to new() must be a HASH re throws_ok { Foo->does() } qr/^\QYou must supply a role name to does()/, 'Cannot call does() without a role name'; + +done_testing; diff --git a/t/010_basics/018_methods.t b/t/010_basics/018_methods.t index bb683bc..53accfe 100644 --- a/t/010_basics/018_methods.t +++ b/t/010_basics/018_methods.t @@ -1,9 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 6; +use Test::More; my $test1 = Mouse::Meta::Class->create_anon_class; @@ -42,3 +45,5 @@ isa_ok( is( $t2_am->name(), 'Test2', 'associated_metaclass->name is Test2' ); + +done_testing; diff --git a/t/010_basics/019-destruction.t b/t/010_basics/019-destruction.t index 72cd82a..0fd614b 100644 --- a/t/010_basics/019-destruction.t +++ b/t/010_basics/019-destruction.t @@ -1,9 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 3; +use Test::More; our @demolished; package Foo; @@ -49,3 +52,5 @@ is_deeply(\@demolished, ['Foo::Sub', 'Foo'], "Foo::Sub demolished properly"); is_deeply(\@demolished, ['Foo::Sub::Sub', 'Foo::Sub', 'Foo'], "Foo::Sub::Sub demolished properly"); @demolished = (); + +done_testing; diff --git a/t/010_basics/020-global-destruction-helper.pl b/t/010_basics/020-global-destruction-helper.pl index a690d4d..fc0c3a8 100644 --- a/t/010_basics/020-global-destruction-helper.pl +++ b/t/010_basics/020-global-destruction-helper.pl @@ -1,8 +1,11 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -no warnings 'once'; # work around 5.6.2 + { package Foo; @@ -12,7 +15,7 @@ no warnings 'once'; # work around 5.6.2 my $self = shift; my ($igd) = @_; - print $igd || 0, "\n"; + print $igd; } } @@ -24,7 +27,7 @@ no warnings 'once'; # work around 5.6.2 my $self = shift; my ($igd) = @_; - print $igd || 0, "\n"; + print $igd; } __PACKAGE__->meta->make_immutable; diff --git a/t/010_basics/020-global-destruction.t b/t/010_basics/020-global-destruction.t index 42aa362..6ec3a6b 100644 --- a/t/010_basics/020-global-destruction.t +++ b/t/010_basics/020-global-destruction.t @@ -1,4 +1,7 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; @@ -43,14 +46,9 @@ use Test::More; my $bar = Bar->new; } -$? = 0; - -my $blib = $INC{'blib.pm'} ? ' -Mblib ' : ''; -my @status = `$^X $blib t/010_basics/020-global-destruction-helper.pl`; - -ok $status[0], 'in_global_destruction state is passed to DEMOLISH properly (true)'; -ok $status[1], 'in_global_destruction state is passed to DEMOLISH properly (true)'; - -is $?, 0, 'exited successfully'; +ok( + $_, + 'in_global_destruction state is passed to DEMOLISH properly (true)' +) for split //, `$^X t/010_basics/020-global-destruction-helper.pl`; done_testing; diff --git a/t/010_basics/021-moose-object-does.t b/t/010_basics/021-moose-object-does.t new file mode 100644 index 0000000..60403fd --- /dev/null +++ b/t/010_basics/021-moose-object-does.t @@ -0,0 +1,161 @@ +use strict; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use warnings; + +use Test::More; +use Test::Mouse; + +{ + package Role::A; + use Mouse::Role +} + +{ + package Role::B; + use Mouse::Role +} + +{ + package Foo; + use Mouse; +} + +{ + package Bar; + use Mouse; + + with 'Role::A'; +} + +{ + package Baz; + use Mouse; + + with qw( Role::A Role::B ); +} + +{ + package Foo::Child; + use Mouse; + + extends 'Foo'; +} + +{ + package Bar::Child; + use Mouse; + + extends 'Bar'; +} + +{ + package Baz::Child; + use Mouse; + + extends 'Baz'; +} + +with_immutable { + + for my $thing ( 'Foo', Foo->new, 'Foo::Child', Foo::Child->new ) { + my $name = ref $thing ? (ref $thing) . ' object' : "$thing class"; + $name .= ' (immutable)' if $thing->meta->is_immutable; + + ok( + !$thing->does('Role::A'), + "$name does not do Role::A" + ); + ok( + !$thing->does('Role::B'), + "$name does not do Role::B" + ); + + ok( + !$thing->does( Role::A->meta ), + "$name does not do Role::A (passed as object)" + ); + ok( + !$thing->does( Role::B->meta ), + "$name does not do Role::B (passed as object)" + ); + + ok( + !$thing->DOES('Role::A'), + "$name does not do Role::A (using DOES)" + ); + ok( + !$thing->DOES('Role::B'), + "$name does not do Role::B (using DOES)" + ); + } + + for my $thing ( 'Bar', Bar->new, 'Bar::Child', Bar::Child->new ) { + my $name = ref $thing ? (ref $thing) . ' object' : "$thing class"; + $name .= ' (immutable)' if $thing->meta->is_immutable; + + ok( + $thing->does('Role::A'), + "$name does Role::A" + ); + ok( + !$thing->does('Role::B'), + "$name does not do Role::B" + ); + + ok( + $thing->does( Role::A->meta ), + "$name does Role::A (passed as object)" + ); + ok( + !$thing->does( Role::B->meta ), + "$name does not do Role::B (passed as object)" + ); + + ok( + $thing->DOES('Role::A'), + "$name does Role::A (using DOES)" + ); + ok( + !$thing->DOES('Role::B'), + "$name does not do Role::B (using DOES)" + ); + } + + for my $thing ( 'Baz', Baz->new, 'Baz::Child', Baz::Child->new ) { + my $name = ref $thing ? (ref $thing) . ' object' : "$thing class"; + $name .= ' (immutable)' if $thing->meta->is_immutable; + + ok( + $thing->does('Role::A'), + "$name does Role::A" + ); + ok( + $thing->does('Role::B'), + "$name does Role::B" + ); + + ok( + $thing->does( Role::A->meta ), + "$name does Role::A (passed as object)" + ); + ok( + $thing->does( Role::B->meta ), + "$name does Role::B (passed as object)" + ); + + ok( + $thing->DOES('Role::A'), + "$name does Role::A (using DOES)" + ); + ok( + $thing->DOES('Role::B'), + "$name does Role::B (using DOES)" + ); + } + +} +qw( Foo Bar Baz Foo::Child Bar::Child Baz::Child ); + +done_testing; diff --git a/t/020_attributes/001_attribute_reader_generation.t b/t/020_attributes/001_attribute_reader_generation.t index dc15fe4..aaced4b 100644 --- a/t/020_attributes/001_attribute_reader_generation.t +++ b/t/020_attributes/001_attribute_reader_generation.t @@ -1,9 +1,13 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; @@ -67,8 +71,6 @@ use Test::Exception; ok( $attr->is_lazy, "it's lazy" ); - note 'skip Moose specific features'; - last; is( $attr->get_raw_value($foo), undef, "raw value" ); is( $attr->get_value($foo), 10, "lazy value" ); diff --git a/t/020_attributes/002_attribute_writer_generation.t b/t/020_attributes/002_attribute_writer_generation.t index 0c49739..05df0ea 100644 --- a/t/020_attributes/002_attribute_writer_generation.t +++ b/t/020_attributes/002_attribute_writer_generation.t @@ -1,15 +1,17 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 29; +use Test::More; use Test::Exception; use Scalar::Util 'isweak'; - { package Foo; use Mouse; @@ -117,5 +119,4 @@ use Scalar::Util 'isweak'; ok(isweak($foo->{foo_weak}), '... it is a weak reference'); } - - +done_testing; diff --git a/t/020_attributes/003_attribute_accessor_generation.t b/t/020_attributes/003_attribute_accessor_generation.t index 4b8620b..c2dbb59 100644 --- a/t/020_attributes/003_attribute_accessor_generation.t +++ b/t/020_attributes/003_attribute_accessor_generation.t @@ -1,15 +1,17 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 57; +use Test::More; use Test::Exception; use Scalar::Util 'isweak'; - { package Foo; use Mouse; @@ -204,5 +206,4 @@ use Scalar::Util 'isweak'; is_deeply( \%hash, { foo => 1, bar => 2 }, "list context"); } - - +done_testing; diff --git a/t/020_attributes/004_attribute_triggers.t b/t/020_attributes/004_attribute_triggers.t index 1d25f57..e46e149 100644 --- a/t/020_attributes/004_attribute_triggers.t +++ b/t/020_attributes/004_attribute_triggers.t @@ -1,4 +1,7 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; @@ -6,6 +9,7 @@ use warnings; use Scalar::Util 'isweak'; use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; @@ -182,9 +186,6 @@ use Test::Exception; $attr->set_value( $foo, 3 ); - note 'skip Moose specific features'; - last; - is_deeply( \@Foo::calls, [ [ $foo, 3, 2 ] ], @@ -203,9 +204,6 @@ use Test::Exception; } { - note 'skip Moose specific features'; - last; - my $foo = Foo->new(foo => 2); is_deeply( \@Foo::calls, diff --git a/t/020_attributes/006_attribute_required.t b/t/020_attributes/006_attribute_required.t index ba61a74..1d81f13 100644 --- a/t/020_attributes/006_attribute_required.t +++ b/t/020_attributes/006_attribute_required.t @@ -1,13 +1,15 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 15; +use Test::More; use Test::Exception; - { package Foo; use Mouse; @@ -66,3 +68,4 @@ throws_ok { Foo->new; } qr/^Attribute \(bar\) is required/, '... must supply all the required attribute'; +done_testing; diff --git a/t/020_attributes/007_attribute_custom_metaclass.t b/t/020_attributes/007_attribute_custom_metaclass.t index 702cd62..00256f7 100644 --- a/t/020_attributes/007_attribute_custom_metaclass.t +++ b/t/020_attributes/007_attribute_custom_metaclass.t @@ -1,13 +1,15 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 16; +use Test::More; use Test::Exception; - { package Foo::Meta::Attribute; use Mouse; @@ -43,15 +45,13 @@ use Test::Exception; isa_ok($foo_attr_type_constraint, 'Mouse::Meta::TypeConstraint'); is($foo_attr_type_constraint->name, 'Foo', '... got the right type constraint name'); - - is($foo_attr_type_constraint->parent, 'Object', '... got the right type constraint parent name'); + is($foo_attr_type_constraint->parent->name, 'Object', '... got the right type constraint parent name'); } { package Bar::Meta::Attribute; use Mouse; - #extends 'Class::MOP::Attribute'; - extends 'Foo::Meta::Attribute'; + extends 'Mouse::Meta::Attribute'; package Bar; use Mouse; @@ -92,4 +92,4 @@ use Test::Exception; isa_ok($bar_attr, 'Mouse::Meta::Attribute'); } - +done_testing; diff --git a/t/020_attributes/008_attribute_type_unions.t b/t/020_attributes/008_attribute_type_unions.t index b1227a5..6c0adb3 100644 --- a/t/020_attributes/008_attribute_type_unions.t +++ b/t/020_attributes/008_attribute_type_unions.t @@ -1,13 +1,15 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 18; +use Test::More; use Test::Exception; - { package Foo; use Mouse; @@ -96,4 +98,4 @@ dies_ok { Bar->new(baz => {}) } '... didnt create a new Bar with baz as a HASH ref'; - +done_testing; diff --git a/t/020_attributes/009_attribute_inherited_slot_specs.t b/t/020_attributes/009_attribute_inherited_slot_specs.t index 7f9cf6d..7e83dbe 100644 --- a/t/020_attributes/009_attribute_inherited_slot_specs.t +++ b/t/020_attributes/009_attribute_inherited_slot_specs.t @@ -1,4 +1,7 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; diff --git a/t/020_attributes/012_misc_attribute_tests.t b/t/020_attributes/012_misc_attribute_tests.t index 8dc93ed..56bfe21 100644 --- a/t/020_attributes/012_misc_attribute_tests.t +++ b/t/020_attributes/012_misc_attribute_tests.t @@ -1,13 +1,15 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 43; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; -use lib 't/lib'; -use Test::Mouse; { { @@ -65,7 +67,7 @@ use Test::Mouse; lives_ok { $test->good_lazy_attr; - } '... this does work'; + } '... this does not work'; } { @@ -246,9 +248,8 @@ use Test::Mouse; ok(!$instance->_has_foo, "noo _foo value yet"); is($instance->foo, 'works', "foo builder works"); is($instance->_foo, 'works too', "foo builder works too"); - dies_ok { $instance->fool } -# throws_ok { $instance->fool } -# qr/Test::LazyBuild::Attribute does not support builder method \'_build_fool\' for attribute \'fool\'/, + throws_ok { $instance->fool } + qr/Test::LazyBuild::Attribute does not support builder method \'_build_fool\' for attribute \'fool\'/, "Correct error when a builder method is not present"; } @@ -259,12 +260,11 @@ use Test::Mouse; use Mouse; } -# Mouse::Exporter does not support 'with_meta' -#lives_ok { OutOfClassTest::has('foo', is => 'bare'); } 'create attr via direct sub call'; -#lives_ok { OutOfClassTest->can('has')->('bar', is => 'bare'); } 'create attr via can'; +lives_ok { OutOfClassTest::has('foo', is => 'bare'); } 'create attr via direct sub call'; +lives_ok { OutOfClassTest->can('has')->('bar', is => 'bare'); } 'create attr via can'; -#ok(OutOfClassTest->meta->get_attribute('foo'), 'attr created from sub call'); -#ok(OutOfClassTest->meta->get_attribute('bar'), 'attr created from can'); +ok(OutOfClassTest->meta->get_attribute('foo'), 'attr created from sub call'); +ok(OutOfClassTest->meta->get_attribute('bar'), 'attr created from can'); { @@ -277,3 +277,5 @@ use Test::Mouse; } } + +done_testing; diff --git a/t/020_attributes/013_attr_dereference_test.t b/t/020_attributes/013_attr_dereference_test.t index 7389df8..0b0ecd4 100644 --- a/t/020_attributes/013_attr_dereference_test.t +++ b/t/020_attributes/013_attr_dereference_test.t @@ -1,13 +1,15 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 11; +use Test::More; use Test::Exception; - { package Customer; use Mouse; @@ -79,3 +81,5 @@ use Test::Exception; is_deeply [ $autoderef->bar ], [ 1, 2, 3 ], '... auto-dereffed correctly'; } + +done_testing; diff --git a/t/020_attributes/014_misc_attribute_coerce_lazy.t b/t/020_attributes/014_misc_attribute_coerce_lazy.t index ccd8883..7ecfbd6 100644 --- a/t/020_attributes/014_misc_attribute_coerce_lazy.t +++ b/t/020_attributes/014_misc_attribute_coerce_lazy.t @@ -1,9 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 2; +use Test::More; use Test::Exception; @@ -47,5 +50,4 @@ lives_ok { $r->headers; } '... this coerces and passes the type constraint even with lazy'; - - +done_testing; diff --git a/t/020_attributes/015_attribute_traits.t b/t/020_attributes/015_attribute_traits.t index 675d22c..baf3eb8 100644 --- a/t/020_attributes/015_attribute_traits.t +++ b/t/020_attributes/015_attribute_traits.t @@ -1,15 +1,15 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use lib 't/lib'; - -use Test::More tests => 12; +use Test::More; use Test::Exception; use Test::Mouse; -use MooseCompat; { package My::Attribute::Trait; @@ -66,5 +66,4 @@ ok(!$gorch_attr->does('My::Attribute::Trait'), '... gorch doesnt do the trait'); ok(!$gorch_attr->has_applied_traits, '... no traits applied'); is($gorch_attr->applied_traits, undef, '... no traits applied'); - - +done_testing; diff --git a/t/020_attributes/016_attribute_traits_registered.t b/t/020_attributes/016_attribute_traits_registered.t index bb216f9..c34cb4e 100644 --- a/t/020_attributes/016_attribute_traits_registered.t +++ b/t/020_attributes/016_attribute_traits_registered.t @@ -1,16 +1,17 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use lib 't/lib'; - -use Test::More tests => 23; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; use Test::Mouse; - { package My::Attribute::Trait; use Mouse::Role; @@ -89,10 +90,7 @@ does_ok($bar_attr, 'My::Attribute::Trait'); is($bar_attr->foo, "blah", "attr initialized"); ok(!$bar_attr->meta->does_role('Aliased'), "does_role ignores aliases for sanity"); -{ -local $TODO = 'aliased name is not supported'; ok($bar_attr->does('Aliased'), "attr->does uses aliases"); -} ok(!$bar_attr->meta->does_role('Fictional'), "does_role returns false for nonexistent roles"); ok(!$bar_attr->does('Fictional'), "attr->does returns false for nonexistent roles"); @@ -113,13 +111,11 @@ does_ok($derived_bar_attr, 'My::Other::Attribute::Trait' ); is($derived_bar_attr->the_other_attr, "oink", "attr initialized" ); ok(!$derived_bar_attr->meta->does_role('Aliased'), "does_role ignores aliases for sanity"); -{ -local $TODO = 'aliased name is not supported'; ok($derived_bar_attr->does('Aliased'), "attr->does uses aliases"); -} ok(!$derived_bar_attr->meta->does_role('Fictional'), "does_role returns false for nonexistent roles"); ok(!$derived_bar_attr->does('Fictional'), "attr->does returns false for nonexistent roles"); can_ok($quux, 'additional_method'); is(eval { $quux->additional_method }, 42, '... got the right value for additional_method'); +done_testing; diff --git a/t/020_attributes/017_attribute_traits_n_meta.t b/t/020_attributes/017_attribute_traits_n_meta.t index 4d96e6c..5ffd186 100644 --- a/t/020_attributes/017_attribute_traits_n_meta.t +++ b/t/020_attributes/017_attribute_traits_n_meta.t @@ -1,11 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use lib 't/lib'; - -use Test::More tests => 7; +use Test::More; use Test::Exception; use Test::Mouse; @@ -65,6 +66,4 @@ isa_ok($c->meta->get_attribute('bar'), 'My::Meta::Attribute::DefaultReadOnly'); does_ok($c->meta->get_attribute('bar'), 'My::Attribute::Trait'); is($c->meta->get_attribute('bar')->_is_metadata, 'ro', '... got the right metaclass customization'); - - - +done_testing; diff --git a/t/020_attributes/018_no_init_arg.t b/t/020_attributes/018_no_init_arg.t index 40b53cc..3263142 100644 --- a/t/020_attributes/018_no_init_arg.t +++ b/t/020_attributes/018_no_init_arg.t @@ -1,9 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 4; +use Test::More; use Test::Exception; @@ -31,3 +34,5 @@ use Test::Exception; is( $foo->foo, "blah", "field is set via setter" ); } + +done_testing; diff --git a/t/020_attributes/failing/019_attribute_lazy_initializer.t b/t/020_attributes/019_attribute_lazy_initializer.t similarity index 94% rename from t/020_attributes/failing/019_attribute_lazy_initializer.t rename to t/020_attributes/019_attribute_lazy_initializer.t index 5e72276..eb4dd91 100644 --- a/t/020_attributes/failing/019_attribute_lazy_initializer.t +++ b/t/020_attributes/019_attribute_lazy_initializer.t @@ -1,13 +1,16 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 23; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; - { package Foo; use Mouse; @@ -148,3 +151,4 @@ dies_ok { Fail::Bar->new(foo => 10) } '... this fails, because initializer returns a bad type'; +done_testing; diff --git a/t/020_attributes/020_trigger_and_coerce.t b/t/020_attributes/020_trigger_and_coerce.t index 38d3e91..78bc5d7 100644 --- a/t/020_attributes/020_trigger_and_coerce.t +++ b/t/020_attributes/020_trigger_and_coerce.t @@ -1,13 +1,15 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 11; +use Test::More; use Test::Exception; - { package Fake::DateTime; @@ -54,3 +56,4 @@ ok( Mortgage->meta->is_immutable, '... Mortgage is now immutable' ); isa_ok( $mtg->closing_date, 'Fake::DateTime' ); } +done_testing; diff --git a/t/020_attributes/022_illegal_options_for_inheritance.t b/t/020_attributes/022_illegal_options_for_inheritance.t index 4bfbf14..1c9b6ce 100644 --- a/t/020_attributes/022_illegal_options_for_inheritance.t +++ b/t/020_attributes/022_illegal_options_for_inheritance.t @@ -1,4 +1,7 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; diff --git a/t/020_attributes/024_attribute_traits_parameterized.t b/t/020_attributes/024_attribute_traits_parameterized.t index 57a3d05..e6b110b 100644 --- a/t/020_attributes/024_attribute_traits_parameterized.t +++ b/t/020_attributes/024_attribute_traits_parameterized.t @@ -1,7 +1,10 @@ #!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 5; +use Test::More; { package My::Attribute::Trait; @@ -55,3 +58,4 @@ is($other_attr->reversed, 'oof', 'the aliased method is in the attribute'); ok(!$other_attr->can('enam'), "the method was not installed under the other class' alias"); ok(!$other_attr->can('reversed_name'), "the method was not installed under the original name when that was excluded"); +done_testing; diff --git a/t/020_attributes/025_chained_coercion.t b/t/020_attributes/025_chained_coercion.t index 894d6ea..885e7a5 100644 --- a/t/020_attributes/025_chained_coercion.t +++ b/t/020_attributes/025_chained_coercion.t @@ -1,9 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 4; +use Test::More; use Test::Exception; { @@ -46,4 +49,4 @@ isa_ok($foo->bar, 'Bar'); isa_ok($foo->bar->baz, 'Baz'); is($foo->bar->baz->hello, 'World', '... this all worked fine'); - +done_testing; diff --git a/t/020_attributes/026_attribute_without_any_methods.t b/t/020_attributes/026_attribute_without_any_methods.t index 0acf3c0..36a6a19 100644 --- a/t/020_attributes/026_attribute_without_any_methods.t +++ b/t/020_attributes/026_attribute_without_any_methods.t @@ -1,9 +1,12 @@ #!/usr/bin/perl -BEGIN{ $ENV{MOUSE_VERBOSE} = 1 } +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + use strict; use warnings; -use Test::More tests => 2; +use Test::More; use Mouse (); use Mouse::Meta::Class; @@ -20,3 +23,5 @@ like $warn, qr/Attribute \(foo\) of class Banana has no associated methods/, $warn = ''; $meta->add_attribute('bar', is => 'bare'); is $warn, '', 'add attribute with no methods and is => "bare"'; + +done_testing; diff --git a/t/020_attributes/failing/027_accessor_override_method.t b/t/020_attributes/027_accessor_override_method.t similarity index 73% rename from t/020_attributes/failing/027_accessor_override_method.t rename to t/020_attributes/027_accessor_override_method.t index 8285b69..6ad9219 100644 --- a/t/020_attributes/failing/027_accessor_override_method.t +++ b/t/020_attributes/027_accessor_override_method.t @@ -1,13 +1,14 @@ #!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; use Test::More; -BEGIN { - eval "use Test::Output;"; - plan skip_all => "Test::Output is required for this test" if $@; - plan tests => 5; -} +use Test::Requires { + 'Test::Output' => '0.01', # skip all if not installed +}; { package Foo; @@ -31,3 +32,8 @@ stderr_like(sub { $foo_meta->add_attribute(d => (clearer => 'clear_d')) }, qr/^You are overwriting a locally defined method \(clear_d\) with an accessor/, 'clearer overriding gives proper warning'); stderr_like(sub { $foo_meta->add_attribute(e => (is => 'rw')) }, qr/^You are overwriting a locally defined method \(e\) with an accessor/, 'accessor overriding gives proper warning'); + +stderr_like(sub { $foo_meta->add_attribute(has => (is => 'rw')) }, + qr/^You are overwriting a locally defined function \(has\) with an accessor/, 'function overriding gives proper warning'); + +done_testing; diff --git a/t/020_attributes/029_accessor_context.t b/t/020_attributes/029_accessor_context.t index b959f31..4728892 100644 --- a/t/020_attributes/029_accessor_context.t +++ b/t/020_attributes/029_accessor_context.t @@ -1,8 +1,11 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 14; +use Test::More; use Test::Exception; lives_ok { @@ -66,3 +69,5 @@ lives_ok { is_deeply [$o->h_ro], [], 'uninitialized HashRef attribute/ro in list context'; } 'testing'; + +done_testing; diff --git a/t/020_attributes/030_non_alpha_attr_names.t b/t/020_attributes/030_non_alpha_attr_names.t index 81105a8..66f4fe2 100644 --- a/t/020_attributes/030_non_alpha_attr_names.t +++ b/t/020_attributes/030_non_alpha_attr_names.t @@ -1,7 +1,11 @@ use strict; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use warnings; -use Test::More tests => 12; +use Test::More; +use Test::Mouse; { package Foo; @@ -12,30 +16,54 @@ use Test::More tests => 12; default => 1, ); + # Assigning types to these non-alpha attrs exposed a bug in Mouse. has '@type' => ( + isa => 'Str', required => 0, reader => 'get_at_type', - default => 2, + writer => 'set_at_type', + default => 'at type', ); has 'has spaces' => ( + isa => 'Int', required => 0, reader => 'get_hs', default => 42, ); + has '!req' => ( + required => 1, + reader => 'req' + ); + no Mouse; } -{ - my $foo = Foo->new; - +with_immutable { ok( Foo->meta->has_attribute($_), "Foo has '$_' attribute" ) for 'type', '@type', 'has spaces'; - is( $foo->get_type, 1, q{'type' attribute default is 1} ); - is( $foo->get_at_type, 2, q{'@type' attribute default is 1} ); - is( $foo->get_hs, 42, q{'has spaces' attribute default is 42} ); + my $foo = Foo->new( '!req' => 42 ); + + is( $foo->get_type, 1, q{'type' attribute default is 1} ); + is( $foo->get_at_type, 'at type', q{'@type' attribute default is 1} ); + is( $foo->get_hs, 42, q{'has spaces' attribute default is 42} ); - Foo->meta->make_immutable, redo if Foo->meta->is_mutable; + $foo = Foo->new( + type => 'foo', + '@type' => 'bar', + 'has spaces' => 200, + '!req' => 84, + ); + + isa_ok( $foo, 'Foo' ); + is( $foo->get_at_type, 'bar', q{reader for '@type'} ); + is( $foo->get_hs, 200, q{reader for 'has spaces'} ); + + $foo->set_at_type(99); + is( $foo->get_at_type, 99, q{writer for '@type' worked} ); } +'Foo'; + +done_testing; diff --git a/t/020_attributes/failing/031_delegation_and_modifiers.t b/t/020_attributes/031_delegation_and_modifiers.t similarity index 84% rename from t/020_attributes/failing/031_delegation_and_modifiers.t rename to t/020_attributes/031_delegation_and_modifiers.t index 2a8d62a..0fca0a7 100644 --- a/t/020_attributes/failing/031_delegation_and_modifiers.t +++ b/t/020_attributes/031_delegation_and_modifiers.t @@ -1,9 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 5; +use Test::More; use Test::Exception; { @@ -54,10 +57,4 @@ is($foo->baz, 'Bar::baz', '... got the right delegated method'); ok($foo->test, '... the test value has now been changed'); - - - - - - - +done_testing; diff --git a/t/020_attributes/032_delegation_arg_aliasing.t b/t/020_attributes/032_delegation_arg_aliasing.t new file mode 100644 index 0000000..084c2ba --- /dev/null +++ b/t/020_attributes/032_delegation_arg_aliasing.t @@ -0,0 +1,44 @@ +#!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use strict; +use warnings; +use Test::More; + +{ + package Foo; + use Mouse; + + sub aliased { + my $self = shift; + $_[1] = $_[0]; + } +} + +{ + package HasFoo; + use Mouse; + + has foo => ( + is => 'ro', + isa => 'Foo', + handles => { + foo_aliased => 'aliased', + foo_aliased_curried => ['aliased', 'bar'], + } + ); +} + +my $hasfoo = HasFoo->new(foo => Foo->new); +my $x; +$hasfoo->foo->aliased('foo', $x); +is($x, 'foo', "direct aliasing works"); +undef $x; +$hasfoo->foo_aliased('foo', $x); +is($x, 'foo', "delegated aliasing works"); +undef $x; +$hasfoo->foo_aliased_curried($x); +is($x, 'bar', "delegated aliasing with currying works"); + +done_testing; diff --git a/t/020_attributes/034_bad_coerce.t b/t/020_attributes/034_bad_coerce.t new file mode 100644 index 0000000..6df64de --- /dev/null +++ b/t/020_attributes/034_bad_coerce.t @@ -0,0 +1,37 @@ +use strict; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use warnings; + +use Test::More; + +use Test::Requires { + 'Test::Output' => '0.01', # skip all if not installed +}; + +{ + package Foo; + + use Mouse; + + ::stderr_like{ has foo => ( + is => 'ro', + isa => 'Str', + coerce => 1, + ); + } + qr/\QYou cannot coerce an attribute (foo) unless its type (Str) has a coercion/, + 'Cannot coerce unless the type has a coercion'; + + ::stderr_like{ has bar => ( + is => 'ro', + isa => 'Str', + coerce => 1, + ); + } + qr/\QYou cannot coerce an attribute (bar) unless its type (Str) has a coercion/, + 'Cannot coerce unless the type has a coercion - different attribute'; +} + +done_testing; diff --git a/t/020_attributes/034_numeric_defaults.t b/t/020_attributes/034_numeric_defaults.t new file mode 100644 index 0000000..ee5dfe8 --- /dev/null +++ b/t/020_attributes/034_numeric_defaults.t @@ -0,0 +1,131 @@ +#!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use strict; +use warnings; +use Test::More; +use Test::Mouse; +use B; + +{ + package Foo; + use Mouse; + + has foo => (is => 'ro', default => 100); + + sub bar { 100 } +} + +with_immutable { + my $foo = Foo->new; + for my $meth (qw(foo bar)) { + my $val = $foo->$meth; + my $b = B::svref_2object(\$val); + my $flags = $b->FLAGS; + ok($flags & B::SVf_IOK || $flags & B::SVp_IOK, "it's an int"); + ok(!($flags & B::SVf_POK), "not a string"); + } +} 'Foo'; + +{ + package Bar; + use Mouse; + + has foo => (is => 'ro', lazy => 1, default => 100); + + sub bar { 100 } +} + +with_immutable { + my $bar = Bar->new; + for my $meth (qw(foo bar)) { + my $val = $bar->$meth; + my $b = B::svref_2object(\$val); + my $flags = $b->FLAGS; + ok($flags & B::SVf_IOK || $flags & B::SVp_IOK, "it's an int"); + ok(!($flags & B::SVf_POK), "not a string"); + } +} 'Bar'; + +{ + package Baz; + use Mouse; + + has foo => (is => 'ro', isa => 'Int', lazy => 1, default => 100); + + sub bar { 100 } +} + +with_immutable { + my $baz = Baz->new; + for my $meth (qw(foo bar)) { + my $val = $baz->$meth; + my $b = B::svref_2object(\$val); + my $flags = $b->FLAGS; + ok($flags & B::SVf_IOK || $flags & B::SVp_IOK, "it's an int"); + ok(!($flags & B::SVf_POK), "not a string"); + } +} 'Baz'; + +{ + package Foo2; + use Mouse; + + has foo => (is => 'ro', default => 10.5); + + sub bar { 10.5 } +} + +with_immutable { + my $foo2 = Foo2->new; + for my $meth (qw(foo bar)) { + my $val = $foo2->$meth; + my $b = B::svref_2object(\$val); + my $flags = $b->FLAGS; + ok($flags & B::SVf_NOK || $flags & B::SVp_NOK, "it's a num"); + ok(!($flags & B::SVf_POK), "not a string"); + } +} 'Foo2'; + +{ + package Bar2; + use Mouse; + + has foo => (is => 'ro', lazy => 1, default => 10.5); + + sub bar { 10.5 } +} + +with_immutable { + my $bar2 = Bar2->new; + for my $meth (qw(foo bar)) { + my $val = $bar2->$meth; + my $b = B::svref_2object(\$val); + my $flags = $b->FLAGS; + ok($flags & B::SVf_NOK || $flags & B::SVp_NOK, "it's a num"); + ok(!($flags & B::SVf_POK), "not a string"); + } +} 'Bar2'; + +{ + package Baz2; + use Mouse; + + has foo => (is => 'ro', isa => 'Num', lazy => 1, default => 10.5); + + sub bar { 10.5 } +} + +with_immutable { + my $baz2 = Baz2->new; + for my $meth (qw(foo bar)) { + my $val = $baz2->$meth; + my $b = B::svref_2object(\$val); + my $flags = $b->FLAGS; + ok($flags & B::SVf_NOK || $flags & B::SVp_NOK, "it's a num"); + ok(!($flags & B::SVf_POK), "not a string"); + } +} 'Baz2'; + +done_testing; diff --git a/t/020_attributes/035_default_undef.t b/t/020_attributes/035_default_undef.t new file mode 100644 index 0000000..3d899a3 --- /dev/null +++ b/t/020_attributes/035_default_undef.t @@ -0,0 +1,27 @@ +#!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use strict; +use warnings; +use Test::More; +use Test::Mouse; + +{ + package Foo; + use Mouse; + + has foo => ( + is => 'ro', + isa => 'Maybe[Int]', + default => undef, + predicate => 'has_foo', + ); +} + +with_immutable { + is(Foo->new->foo, undef); + ok(Foo->new->has_foo); +} 'Foo'; + +done_testing; diff --git a/t/030_roles/002_role.t b/t/030_roles/002_role.t index 2504039..ddba337 100644 --- a/t/030_roles/002_role.t +++ b/t/030_roles/002_role.t @@ -1,16 +1,15 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 40; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; -use lib 't/lib'; -use Test::Mouse; - -use MooseCompat; - =pod NOTE: @@ -52,14 +51,13 @@ words, should 'has_method' return true for them? my $foo_role = FooRole->meta; isa_ok($foo_role, 'Mouse::Meta::Role'); -#isa_ok($foo_role, 'Class::MOP::Module'); +isa_ok($foo_role, 'Mouse::Meta::Module'); is($foo_role->name, 'FooRole', '... got the right name of FooRole'); is($foo_role->version, '0.01', '... got the right version of FooRole'); # methods ... - ok($foo_role->has_method('foo'), '... FooRole has the foo method'); is($foo_role->get_method('foo')->body, \&FooRole::foo, '... FooRole got the foo method'); @@ -92,27 +90,20 @@ is($bar_attr->{is}, 'rw', 'bar attribute is rw'); is($bar_attr->{isa}, 'Foo', 'bar attribute isa Foo'); -{ - local $TODO = 'definition_context is not yet implemented'; - is(ref($bar_attr->{definition_context}), 'HASH', - 'bar\'s definition context is a hash'); - is($bar_attr->{definition_context}->{package}, 'FooRole', - 'bar was defined in FooRole'); -} +is(ref($bar_attr->{definition_context}), 'HASH', + 'bar\'s definition context is a hash'); +is($bar_attr->{definition_context}->{package}, 'FooRole', + 'bar was defined in FooRole'); ok($foo_role->has_attribute('baz'), '... FooRole does have the baz attribute'); my $baz_attr = $foo_role->get_attribute('baz'); is($baz_attr->{is}, 'ro', 'baz attribute is ro'); - -{ - local $TODO = 'definition_context is not yet implemented'; - is(ref($baz_attr->{definition_context}), 'HASH', - 'bar\'s definition context is a hash'); - is($baz_attr->{definition_context}->{package}, 'FooRole', - 'baz was defined in FooRole'); -} +is(ref($baz_attr->{definition_context}), 'HASH', + 'bar\'s definition context is a hash'); +is($baz_attr->{definition_context}->{package}, 'FooRole', + 'baz was defined in FooRole'); # method modifiers @@ -166,3 +157,4 @@ is_deeply( [ 'bling', 'fling' ], '... got the right list of override method modifiers'); +done_testing; diff --git a/t/030_roles/004_role_composition_errors.t b/t/030_roles/004_role_composition_errors.t index 8a9b04c..6300061 100644 --- a/t/030_roles/004_role_composition_errors.t +++ b/t/030_roles/004_role_composition_errors.t @@ -1,4 +1,7 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; diff --git a/t/030_roles/005_role_conflict_detection.t b/t/030_roles/005_role_conflict_detection.t index b96851d..88db67c 100644 --- a/t/030_roles/005_role_conflict_detection.t +++ b/t/030_roles/005_role_conflict_detection.t @@ -1,4 +1,7 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; diff --git a/t/030_roles/008_role_conflict_edge_cases.t b/t/030_roles/008_role_conflict_edge_cases.t index 98f9a51..67c1e3d 100644 --- a/t/030_roles/008_role_conflict_edge_cases.t +++ b/t/030_roles/008_role_conflict_edge_cases.t @@ -1,15 +1,14 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 32; +use Test::More; use Test::Exception; -use lib 't/lib'; -use Test::Mouse; -use MooseCompat; - =pod Check for repeated inheritance causing @@ -92,15 +91,10 @@ ok(Role::Base2->meta->has_override_method_modifier('foo'), '... have the method ok(Role::Derived3->meta->has_override_method_modifier('foo'), '... have the method foo as expected'); ok(Role::Derived4->meta->has_override_method_modifier('foo'), '... have the method foo as expected'); ok(My::Test::Class2->meta->has_method('foo'), '... have the method foo as expected'); -{ -local $TODO = 'Not a Mouse::Meta::Method::Overriden'; -isa_ok(My::Test::Class2->meta->get_method('foo'), 'Mouse::Meta::Method::Overridden'); -} +isa_ok(My::Test::Class2->meta->get_method('foo'), 'Mouse::Meta::Method'); ok(My::Test::Class2::Base->meta->has_method('foo'), '... have the method foo as expected'); -{ -local $TODO = 'Not a Class::MOP::Method'; -isa_ok(My::Test::Class2::Base->meta->get_method('foo'), 'Class::MOP::Method'); -} +isa_ok(My::Test::Class2::Base->meta->get_method('foo'), 'Mouse::Meta::Method'); + is(My::Test::Class2::Base->foo, 'My::Test::Class2::Base', '... got the right value from method'); is(My::Test::Class2->foo, 'My::Test::Class2::Base -> Role::Base::foo', '... got the right value from method'); @@ -150,15 +144,10 @@ ok(Role::Base3->meta->has_around_method_modifiers('foo'), '... have the method f ok(Role::Derived5->meta->has_around_method_modifiers('foo'), '... have the method foo as expected'); ok(Role::Derived6->meta->has_around_method_modifiers('foo'), '... have the method foo as expected'); ok(My::Test::Class3->meta->has_method('foo'), '... have the method foo as expected'); -{ -local $TODO = 'Not a Class::MOP::Method::Wrapped'; -isa_ok(My::Test::Class3->meta->get_method('foo'), 'Class::MOP::Method::Wrapped'); -} +isa_ok(My::Test::Class3->meta->get_method('foo'), 'Mouse::Meta::Method'); ok(My::Test::Class3::Base->meta->has_method('foo'), '... have the method foo as expected'); -{ -local $TODO = 'Not a Class::MOP::Method'; -isa_ok(My::Test::Class3::Base->meta->get_method('foo'), 'Class::MOP::Method'); -} +isa_ok(My::Test::Class3::Base->meta->get_method('foo'), 'Mouse::Meta::Method'); + is(My::Test::Class3::Base->foo, 'My::Test::Class3::Base', '... got the right value from method'); is(My::Test::Class3->foo, 'Role::Base::foo(My::Test::Class3::Base)', '... got the right value from method'); @@ -200,3 +189,5 @@ ok(Role::Derived8->meta->has_attribute('foo'), '... have the attribute foo as ex ok(My::Test::Class4->meta->has_attribute('foo'), '... have the attribute foo as expected'); is(My::Test::Class4->new->foo, 'Role::Base::foo', '... got the right value from method'); + +done_testing; diff --git a/t/030_roles/009_more_role_edge_cases.t b/t/030_roles/009_more_role_edge_cases.t index cb504d8..19b833e 100644 --- a/t/030_roles/009_more_role_edge_cases.t +++ b/t/030_roles/009_more_role_edge_cases.t @@ -1,4 +1,7 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; diff --git a/t/030_roles/010_run_time_role_composition.t b/t/030_roles/010_run_time_role_composition.t index c4ba5ce..9a3a5d7 100644 --- a/t/030_roles/010_run_time_role_composition.t +++ b/t/030_roles/010_run_time_role_composition.t @@ -1,9 +1,13 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; use Test::More; +$TODO = q{Mouse is not yet completed}; use Scalar::Util qw(blessed); @@ -61,12 +65,12 @@ isa_ok($obj2, 'My::Class'); } { - ok(!$obj2->does('Bark'), '... we do not do any roles yet'); + ok(!$obj2->does('Sleeper'), '... we do not do any roles yet'); - Bark->meta->apply($obj2); + Sleeper->meta->apply($obj2); - ok($obj2->does('Bark'), '... we now do the Bark role'); - is(blessed($obj), blessed($obj2), '... they share the same anon-class/role thing'); + ok($obj2->does('Sleeper'), '... we now do the Sleeper role'); + isnt(blessed($obj), blessed($obj2), '... they DO NOT share the same anon-class/role thing'); } { @@ -81,7 +85,7 @@ isa_ok($obj2, 'My::Class'); ok(!My::Class->does('Sleeper'), '... the class does not do the Sleeper role'); - isnt(blessed($obj), blessed($obj2), '... they no longer share the same anon-class/role thing'); + isnt(blessed($obj), blessed($obj2), '... they still don\'t share the same anon-class/role thing'); isa_ok($obj, 'My::Class'); @@ -92,12 +96,22 @@ isa_ok($obj2, 'My::Class'); } { - ok(!$obj2->does('Sleeper'), '... we do not do any roles yet'); + ok(!$obj2->does('Bark'), '... we do not do Bark yet'); - Sleeper->meta->apply($obj2); + Bark->meta->apply($obj2); - ok($obj2->does('Sleeper'), '... we now do the Bark role'); - is(blessed($obj), blessed($obj2), '... they share the same anon-class/role thing again'); + ok($obj2->does('Bark'), '... we now do the Bark role'); + isnt(blessed($obj), blessed($obj2), '... they still don\'t share the same anon-class/role thing'); +} + +# test that anon classes are equivalent after role composition in the same order +{ + foreach ($obj, $obj2) { + $_ = My::Class->new; + Bark->meta->apply($_); + Sleeper->meta->apply($_); + } + is(blessed($obj), blessed($obj2), '... they now share the same anon-class/role thing'); } done_testing; diff --git a/t/030_roles/014_more_alias_and_exclude.t b/t/030_roles/014_more_alias_and_exclude.t index ff0fc4d..5b7a294 100644 --- a/t/030_roles/014_more_alias_and_exclude.t +++ b/t/030_roles/014_more_alias_and_exclude.t @@ -1,4 +1,7 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; diff --git a/t/030_roles/015_runtime_roles_and_attrs.t b/t/030_roles/015_runtime_roles_and_attrs.t index 0e5def7..9c55be7 100644 --- a/t/030_roles/015_runtime_roles_and_attrs.t +++ b/t/030_roles/015_runtime_roles_and_attrs.t @@ -1,4 +1,7 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; diff --git a/t/030_roles/016_runtime_roles_and_nonmoose.t b/t/030_roles/016_runtime_roles_and_nonmoose.t index 080fe8a..95afc47 100644 --- a/t/030_roles/016_runtime_roles_and_nonmoose.t +++ b/t/030_roles/016_runtime_roles_and_nonmoose.t @@ -1,4 +1,7 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; diff --git a/t/030_roles/018_runtime_roles_w_params.t b/t/030_roles/018_runtime_roles_w_params.t index aa1a02b..8785cfd 100644 --- a/t/030_roles/018_runtime_roles_w_params.t +++ b/t/030_roles/018_runtime_roles_w_params.t @@ -1,13 +1,16 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 21; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; - { package Foo; use Mouse; @@ -50,10 +53,7 @@ use Test::Exception; is($foo->bar, 'BAR', '... got the expect value'); ok($foo->can('baz'), '... we have baz method now'); - { - local $TODO = 'rebless_params is not implemented'; - is($foo->baz, 'FOO-BAZ', '... got the expect value'); - } + is($foo->baz, 'FOO-BAZ', '... got the expect value'); } # with extra params ... @@ -68,15 +68,9 @@ use Test::Exception; Bar->meta->apply($foo, (rebless_params => { bar => 'FOO-BAR', baz => 'FOO-BAZ' })) } '... this works'; - { - local $TODO = 'rebless params is not implemented'; - is($foo->bar, 'FOO-BAR', '... got the expect value'); - } + is($foo->bar, 'FOO-BAR', '... got the expect value'); ok($foo->can('baz'), '... we have baz method now'); - { - local $TODO = 'rebless params is not implemented'; - is($foo->baz, 'FOO-BAZ', '... got the expect value'); - } + is($foo->baz, 'FOO-BAZ', '... got the expect value'); } - +done_testing; diff --git a/t/030_roles/019_build.t b/t/030_roles/019_build.t index 684443a..341b1c9 100644 --- a/t/030_roles/019_build.t +++ b/t/030_roles/019_build.t @@ -1,13 +1,14 @@ #!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; use Test::More; -BEGIN { - eval "use Test::Output;"; - plan skip_all => "Test::Output is required for this test" if $@; - plan tests => 8; -} +use Test::Requires { + 'Test::Output' => '0.01', # skip all if not installed +}; # this test script ensures that my idiom of: # role: sub BUILD, after BUILD @@ -79,3 +80,4 @@ do { } } +done_testing; diff --git a/t/030_roles/031_roles_applied_in_create.t b/t/030_roles/031_roles_applied_in_create.t index defad7d..42b3d1b 100644 --- a/t/030_roles/031_roles_applied_in_create.t +++ b/t/030_roles/031_roles_applied_in_create.t @@ -1,9 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 1; +use Test::More; use Test::Exception; use Mouse::Meta::Class; use Mouse::Util; @@ -25,3 +28,4 @@ lives_ok( 'Create a new class with several roles' ); +done_testing; diff --git a/t/030_roles/033_role_exclusion_and_alias_bug.t b/t/030_roles/033_role_exclusion_and_alias_bug.t index c47b65c..38a2016 100644 --- a/t/030_roles/033_role_exclusion_and_alias_bug.t +++ b/t/030_roles/033_role_exclusion_and_alias_bug.t @@ -1,10 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 17; -use lib 't/lib'; +use Test::More; use Test::Mouse; { @@ -67,4 +69,4 @@ use Test::Mouse; is($x->gorch, 'BAR', '... got the right value'); } - +done_testing; diff --git a/t/030_roles/034_create_role.t b/t/030_roles/034_create_role.t index 03a8cb8..fa53f5f 100644 --- a/t/030_roles/034_create_role.t +++ b/t/030_roles/034_create_role.t @@ -1,8 +1,11 @@ #!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 4; -use Mouse::Role (); +use Test::More; +use Mouse (); my $role = Mouse::Meta::Role->create( 'MyItem::Role::Equipment', @@ -30,3 +33,4 @@ ok(!$visored->is_worn, "method was consumed"); ok(!$role->is_anon_role, "the role is not anonymous"); +done_testing; diff --git a/t/030_roles/035_anonymous_roles.t b/t/030_roles/035_anonymous_roles.t index 7d64dfc..974327c 100644 --- a/t/030_roles/035_anonymous_roles.t +++ b/t/030_roles/035_anonymous_roles.t @@ -1,7 +1,11 @@ #!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; use Test::More; +$TODO = q{Mouse is not yet completed}; use Mouse (); my $role = Mouse::Meta::Role->create_anon_role( @@ -27,7 +31,7 @@ ok($visored->is_worn, "accessor was consumed"); $visored->remove; ok(!$visored->is_worn, "method was consumed"); -like($role->name, qr/::__ANON__::/, ""); +like($role->name, qr/^Mouse::Meta::Role::__ANON__::SERIAL::\d+$/, ""); ok($role->is_anon_role, "the role knows it's anonymous"); ok(Mouse::Util::is_class_loaded(Mouse::Meta::Role->create_anon_role->name), "creating an anonymous role satisifes is_class_loaded"); diff --git a/t/030_roles/036_free_anonymous_roles.t b/t/030_roles/036_free_anonymous_roles.t index 65b87bf..8426fed 100644 --- a/t/030_roles/036_free_anonymous_roles.t +++ b/t/030_roles/036_free_anonymous_roles.t @@ -1,8 +1,11 @@ #!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 4; -use Mouse::Role (); +use Test::More; +use Mouse (); use Scalar::Util 'weaken'; my $weak; @@ -32,3 +35,5 @@ do { ok(!$weak, "the role metaclass is freed after its last reference (from a consuming anonymous class) is freed"); ok(!$name->can('improperly_freed'), "we blew away the role's symbol table entries"); + +done_testing; diff --git a/t/030_roles/037_create_role_subclass.t b/t/030_roles/037_create_role_subclass.t index d794e12..ce212e7 100644 --- a/t/030_roles/037_create_role_subclass.t +++ b/t/030_roles/037_create_role_subclass.t @@ -1,7 +1,10 @@ #!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 2; +use Test::More; use Mouse (); do { @@ -19,9 +22,9 @@ do { }; my $role = My::Meta::Role->create_anon_role; -#use Data::Dumper; $Data::Dumper::Deparse = 1; print Dumper $role->can('test_serial'); is($role->test_serial, 1, "default value for the serial attribute"); my $nine_role = My::Meta::Role->create_anon_role(test_serial => 9); is($nine_role->test_serial, 9, "parameter value for the serial attribute"); +done_testing; diff --git a/t/030_roles/041_empty_method_modifiers_meta_bug.t b/t/030_roles/041_empty_method_modifiers_meta_bug.t index c6c5faa..2ebe86e 100644 --- a/t/030_roles/041_empty_method_modifiers_meta_bug.t +++ b/t/030_roles/041_empty_method_modifiers_meta_bug.t @@ -1,8 +1,11 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 6; +use Test::More; # test role and class package SomeRole; @@ -26,3 +29,5 @@ for my $modifier_type (qw[ before around after ]) { is($@, '', "$get_func for no method mods does not die"); is(scalar(@mms),0,'is an empty list'); } + +done_testing; diff --git a/t/030_roles/042_compose_overloading.t b/t/030_roles/042_compose_overloading.t index b79fbde..2a685a0 100644 --- a/t/030_roles/042_compose_overloading.t +++ b/t/030_roles/042_compose_overloading.t @@ -1,6 +1,9 @@ use strict; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use warnings; -use Test::More tests => 1; +use Test::More; { package Foo; @@ -26,3 +29,5 @@ TODO: { local $TODO = "the special () method isn't properly composed into the class"; is("$bar", 42, 'overloading can be composed'); } + +done_testing; diff --git a/t/030_roles/045_role_compose_requires.t b/t/030_roles/045_role_compose_requires.t new file mode 100644 index 0000000..6852ec8 --- /dev/null +++ b/t/030_roles/045_role_compose_requires.t @@ -0,0 +1,149 @@ +# See https://rt.cpan.org/Ticket/Display.html?id=46347 +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; +use Test::Exception; + +{ + package My::Role1; + use Mouse::Role; + requires 'test_output'; +} + +{ + package My::Role2; + use Mouse::Role; + has test_output => ( is => 'rw' ); + with 'My::Role1'; +} + +{ + package My::Role3; + use Mouse::Role; + sub test_output { } + with 'My::Role1'; +} + +{ + package My::Role4; + use Mouse::Role; + has test_output => ( is => 'rw' ); +} + +{ + package My::Role5; + use Mouse::Role; + sub test_output { } +} + +{ + package My::Base1; + use Mouse; + has test_output => ( is => 'rw' ); +} + +{ + package My::Base2; + use Mouse; + sub test_output { } +} + +# Roles providing attributes/methods should satisfy requires() of other +# roles they consume. +{ + local $TODO = "role attributes don't satisfy method requirements"; + lives_ok { package My::Test1; use Mouse; with 'My::Role2'; } + 'role2(provides attribute) consumes role1'; +} + +lives_ok { package My::Test2; use Mouse; with 'My::Role3'; } +'role3(provides method) consumes role1'; + +# As I understand the design, Roles composed in the same with() statement +# should NOT demonstrate ordering dependency. Alter these tests if that +# assumption is false. -Vince Veselosky +{ + local $TODO = "role attributes don't satisfy method requirements"; + lives_ok { package My::Test3; use Mouse; with 'My::Role4', 'My::Role1'; } + 'class consumes role4(provides attribute), role1'; +} + +{ + local $TODO = "role attributes don't satisfy method requirements"; + lives_ok { package My::Test4; use Mouse; with 'My::Role1', 'My::Role4'; } + 'class consumes role1, role4(provides attribute)'; +} + +lives_ok { package My::Test5; use Mouse; with 'My::Role5', 'My::Role1'; } +'class consumes role5(provides method), role1'; + +lives_ok { package My::Test6; use Mouse; with 'My::Role1', 'My::Role5'; } +'class consumes role1, role5(provides method)'; + +# Inherited methods/attributes should satisfy requires(), as long as +# extends() comes first in code order. +lives_ok { + package My::Test7; + use Mouse; + extends 'My::Base1'; + with 'My::Role1'; +} +'class extends base1(provides attribute), consumes role1'; + +lives_ok { + package My::Test8; + use Mouse; + extends 'My::Base2'; + with 'My::Role1'; +} +'class extends base2(provides method), consumes role1'; + +# Attributes/methods implemented in class should satisfy requires() +lives_ok { + + package My::Test9; + use Mouse; + has 'test_output', is => 'rw'; + with 'My::Role1'; +} +'class provides attribute, consumes role1'; + +lives_ok { + + package My::Test10; + use Mouse; + sub test_output { } + with 'My::Role1'; +} +'class provides method, consumes role1'; + +# Roles composed in separate with() statements SHOULD demonstrate ordering +# dependency. See comment with tests 3-6 above. +lives_ok { + package My::Test11; + use Mouse; + with 'My::Role4'; + with 'My::Role1'; +} +'class consumes role4(provides attribute); consumes role1'; + +dies_ok { package My::Test12; use Mouse; with 'My::Role1'; with 'My::Role4'; } +'class consumes role1; consumes role4(provides attribute)'; + +lives_ok { + package My::Test13; + use Mouse; + with 'My::Role5'; + with 'My::Role1'; +} +'class consumes role5(provides method); consumes role1'; + +dies_ok { package My::Test14; use Mouse; with 'My::Role1'; with 'My::Role5'; } +'class consumes role1; consumes role5(provides method)'; + +done_testing; diff --git a/t/030_roles/failing/038_new_meta_role.t b/t/030_roles/failing/038_new_meta_role.t deleted file mode 100644 index e0ebe03..0000000 --- a/t/030_roles/failing/038_new_meta_role.t +++ /dev/null @@ -1,18 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 1; - -do { - package My::Meta::Role; - use Mouse; - BEGIN { extends 'Mouse::Meta::Role' }; -}; - -do { - package My::Role; - use Mouse::Role -metaclass => 'My::Meta::Role'; -}; - -is(My::Role->meta->meta->name, 'My::Meta::Role'); - diff --git a/t/030_roles/failing/043_conflict_many_methods.t b/t/030_roles/failing/043_conflict_many_methods.t deleted file mode 100644 index b8eb2c9..0000000 --- a/t/030_roles/failing/043_conflict_many_methods.t +++ /dev/null @@ -1,45 +0,0 @@ -#!/usr/bin/perl -use strict; -use warnings; - -use Test::More tests => 2; -use Test::Exception; - -{ - package Bomb; - use Mouse::Role; - - sub fuse { } - sub explode { } - - package Spouse; - use Mouse::Role; - - sub fuse { } - sub explode { } - - package Caninish; - use Mouse::Role; - - sub bark { } - - package Treeve; - use Mouse::Role; - - sub bark { } -} - -package PracticalJoke; -use Mouse; - -::throws_ok { - with 'Bomb', 'Spouse'; -} qr/Due to method name conflicts in roles 'Bomb' and 'Spouse', the methods 'explode' and 'fuse' must be implemented or excluded by 'PracticalJoke'/; - -::throws_ok { - with ( - 'Bomb', 'Spouse', - 'Caninish', 'Treeve', - ); -} qr/Due to a method name conflict in roles 'Caninish' and 'Treeve', the method 'bark' must be implemented or excluded by 'PracticalJoke'/; - diff --git a/t/040_type_constraints/failing/002_util_type_constraints_export.t b/t/040_type_constraints/002_util_type_constraints_export.t similarity index 77% rename from t/040_type_constraints/failing/002_util_type_constraints_export.t rename to t/040_type_constraints/002_util_type_constraints_export.t index 5d5612c..a6633a0 100644 --- a/t/040_type_constraints/failing/002_util_type_constraints_export.t +++ b/t/040_type_constraints/002_util_type_constraints_export.t @@ -1,9 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 4; +use Test::More; use Test::Exception; { @@ -26,3 +29,5 @@ use Test::Exception; ::ok( MyRef( {} ), '... Ref worked correctly' ); ::ok( MyArrayRef( [] ), '... ArrayRef worked correctly' ); } + +done_testing; diff --git a/t/040_type_constraints/003_util_std_type_constraints.t b/t/040_type_constraints/003_util_std_type_constraints.t index 0ce13fb..1f7a4ec 100644 --- a/t/040_type_constraints/003_util_std_type_constraints.t +++ b/t/040_type_constraints/003_util_std_type_constraints.t @@ -1,4 +1,7 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; @@ -6,7 +9,6 @@ use warnings; use Test::More; use Test::Exception; -use t::lib::MooseCompat; use Scalar::Util (); BEGIN { @@ -192,6 +194,7 @@ ok(!defined ScalarRef([]), '... ScalarRef rejects anything which i ok(!defined ScalarRef({}), '... ScalarRef rejects anything which is not a ScalarRef'); ok(!defined ScalarRef(sub {}), '... ScalarRef rejects anything which is not a ScalarRef'); ok(defined ScalarRef($SCALAR_REF), '... ScalarRef accepts anything which is a ScalarRef'); +ok(defined ScalarRef(\$SCALAR_REF), '... ScalarRef accepts references to references'); ok(!defined ScalarRef($GLOB), '... ScalarRef rejects anything which is not a ScalarRef'); ok(!defined ScalarRef($GLOB_REF), '... ScalarRef rejects anything which is not a ScalarRef'); ok(!defined ScalarRef($fh), '... ScalarRef rejects anything which is not a ScalarRef'); diff --git a/t/040_type_constraints/failing/006_util_type_reloading.t b/t/040_type_constraints/006_util_type_reloading.t similarity index 64% rename from t/040_type_constraints/failing/006_util_type_reloading.t rename to t/040_type_constraints/006_util_type_reloading.t index 4cde153..357c9c3 100644 --- a/t/040_type_constraints/failing/006_util_type_reloading.t +++ b/t/040_type_constraints/006_util_type_reloading.t @@ -1,15 +1,17 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; use lib 't/lib', 'lib'; -use Test::More tests => 4; +use Test::More; use Test::Exception; - $SIG{__WARN__} = sub { 0 }; eval { require Foo; }; @@ -26,4 +28,6 @@ ok(!$@, '... loaded Bar successfully') || diag $@; delete $INC{'Bar.pm'}; eval { require Bar; }; -ok(!$@, '... re-loaded Bar successfully') || diag $@; \ No newline at end of file +ok(!$@, '... re-loaded Bar successfully') || diag $@; + +done_testing; diff --git a/t/040_type_constraints/007_util_more_type_coercion.t b/t/040_type_constraints/007_util_more_type_coercion.t index 1cfa831..ad3bf2b 100644 --- a/t/040_type_constraints/007_util_more_type_coercion.t +++ b/t/040_type_constraints/007_util_more_type_coercion.t @@ -1,13 +1,15 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 25; +use Test::More; use Test::Exception; - { package HTTPHeader; use Mouse; @@ -115,3 +117,4 @@ dies_ok { Engine->new(header => \(my $var)); } '... dies correctly with bad params'; +done_testing; diff --git a/t/040_type_constraints/009_union_types_and_coercions.t b/t/040_type_constraints/009_union_types_and_coercions.t index ca8fcab..91f7cc8 100644 --- a/t/040_type_constraints/009_union_types_and_coercions.t +++ b/t/040_type_constraints/009_union_types_and_coercions.t @@ -1,4 +1,7 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; @@ -6,13 +9,10 @@ use warnings; use Test::More; use Test::Exception; -BEGIN { - eval "use IO::String; use IO::File;"; - plan skip_all => "IO::String and IO::File are required for this test" if $@; - plan tests => 28; -} - - +use Test::Requires { + 'IO::String' => '0.01', # skip all if not installed + 'IO::File' => '0.01', +}; { package Email::Mouse; @@ -47,8 +47,7 @@ BEGIN { # create the alias - my $st = subtype 'IO::StringOrFile' => as 'IO::String | IO::File'; - #::diag $st->dump; + subtype 'IO::StringOrFile' => as 'IO::String | IO::File'; # attributes @@ -62,7 +61,6 @@ BEGIN { sub as_string { my ($self) = @_; my $fh = $self->raw_body(); - return do { local $/; <$fh> }; } } @@ -160,5 +158,36 @@ BEGIN { is($email->raw_body, $fh, '... and it is the one we expected'); } +{ + package Foo; + + use Mouse; + use Mouse::Util::TypeConstraints; + + subtype 'Coerced' => as 'ArrayRef'; + coerce 'Coerced' + => from 'Value' + => via { [ $_ ] }; + + has carray => ( + is => 'ro', + isa => 'Coerced | Coerced', + coerce => 1, + ); +} + +{ + my $foo; + lives_ok { $foo = Foo->new( carray => 1 ) } + 'Can pass non-ref value for carray'; + is_deeply( + $foo->carray, [1], + 'carray was coerced to an array ref' + ); + throws_ok { Foo->new( carray => {} ) } + qr/\QValidation failed for 'Coerced|Coerced' with value \E(?!undef)/, + 'Cannot pass a hash ref for carray attribute, and hash ref is not coerced to an undef'; +} +done_testing; diff --git a/t/040_type_constraints/010_misc_type_tests.t b/t/040_type_constraints/010_misc_type_tests.t index f5cc487..57bc59f 100644 --- a/t/040_type_constraints/010_misc_type_tests.t +++ b/t/040_type_constraints/010_misc_type_tests.t @@ -1,9 +1,13 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; use Scalar::Util qw(refaddr); @@ -23,7 +27,7 @@ isa_ok($numb3rs, 'Mouse::Meta::TypeConstraint'); # subtype with unions { - package Test::Mouse::Meta::TypeConstraint::Union; + package Test::Mouse::Meta::TypeConstraint; use overload '""' => sub {'Broken|Test'}, fallback => 1; use Mouse; @@ -31,12 +35,12 @@ isa_ok($numb3rs, 'Mouse::Meta::TypeConstraint'); extends 'Mouse::Meta::TypeConstraint'; } -my $dummy_instance = Test::Mouse::Meta::TypeConstraint::Union->new; +my $dummy_instance = Test::Mouse::Meta::TypeConstraint->new; ok $dummy_instance => "Created Instance"; isa_ok $dummy_instance, - 'Test::Mouse::Meta::TypeConstraint::Union' => 'isa correct type'; + 'Test::Mouse::Meta::TypeConstraint' => 'isa correct type'; is "$dummy_instance", "Broken|Test" => 'Got expected stringification result'; @@ -79,8 +83,8 @@ ok $subtype2 => 'made a subtype of our subtype'; my $foo = Mouse::Util::TypeConstraints::find_type_constraint('Foo'); my $bar = Mouse::Util::TypeConstraints::find_type_constraint('Bar'); - ok(!$foo->is_a_type_of($bar), "Foo type is not equal to Bar type"); - ok( $foo->is_a_type_of($foo), "Foo equals Foo"); + ok(!$foo->equals($bar), "Foo type is not equal to Bar type"); + ok( $foo->equals($foo), "Foo equals Foo"); ok( 0+$foo == refaddr($foo), "overloading works"); } diff --git a/t/040_type_constraints/failing/011_container_type_constraint.t b/t/040_type_constraints/011_container_type_constraint.t similarity index 76% rename from t/040_type_constraints/failing/011_container_type_constraint.t rename to t/040_type_constraints/011_container_type_constraint.t index 82f1b99..f90f3d7 100644 --- a/t/040_type_constraints/failing/011_container_type_constraint.t +++ b/t/040_type_constraints/011_container_type_constraint.t @@ -1,24 +1,28 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 24; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; BEGIN { use_ok('Mouse::Util::TypeConstraints'); - use_ok('Mouse::Meta::TypeConstraint::Parameterized'); + use_ok('Mouse::Meta::TypeConstraint'); } # Array of Ints -my $array_of_ints = Mouse::Meta::TypeConstraint::Parameterized->new( +my $array_of_ints = Mouse::Meta::TypeConstraint->new( name => 'ArrayRef[Int]', parent => find_type_constraint('ArrayRef'), type_parameter => find_type_constraint('Int'), ); -isa_ok($array_of_ints, 'Mouse::Meta::TypeConstraint::Parameterized'); +isa_ok($array_of_ints, 'Mouse::Meta::TypeConstraint'); isa_ok($array_of_ints, 'Mouse::Meta::TypeConstraint'); ok($array_of_ints->check([ 1, 2, 3, 4 ]), '... [ 1, 2, 3, 4 ] passed successfully'); @@ -31,12 +35,12 @@ ok(!$array_of_ints->check(sub { () }), '... sub { () } failed successfully'); # Hash of Ints -my $hash_of_ints = Mouse::Meta::TypeConstraint::Parameterized->new( +my $hash_of_ints = Mouse::Meta::TypeConstraint->new( name => 'HashRef[Int]', parent => find_type_constraint('HashRef'), type_parameter => find_type_constraint('Int'), ); -isa_ok($hash_of_ints, 'Mouse::Meta::TypeConstraint::Parameterized'); +isa_ok($hash_of_ints, 'Mouse::Meta::TypeConstraint'); isa_ok($hash_of_ints, 'Mouse::Meta::TypeConstraint'); ok($hash_of_ints->check({ one => 1, two => 2, three => 3 }), '... { one => 1, two => 2, three => 3 } passed successfully'); @@ -49,12 +53,12 @@ ok(!$hash_of_ints->check(sub { () }), '... sub { () } failed successfully'); # Array of Array of Ints -my $array_of_array_of_ints = Mouse::Meta::TypeConstraint::Parameterized->new( +my $array_of_array_of_ints = Mouse::Meta::TypeConstraint->new( name => 'ArrayRef[ArrayRef[Int]]', parent => find_type_constraint('ArrayRef'), type_parameter => $array_of_ints, ); -isa_ok($array_of_array_of_ints, 'Mouse::Meta::TypeConstraint::Parameterized'); +isa_ok($array_of_array_of_ints, 'Mouse::Meta::TypeConstraint'); isa_ok($array_of_array_of_ints, 'Mouse::Meta::TypeConstraint'); ok($array_of_array_of_ints->check( @@ -66,8 +70,10 @@ ok(!$array_of_array_of_ints->check( { my $anon_type = Mouse::Util::TypeConstraints::find_or_parse_type_constraint('ArrayRef[Foo]'); - isa_ok( $anon_type, 'Mouse::Meta::TypeConstraint::Parameterized' ); + isa_ok( $anon_type, 'Mouse::Meta::TypeConstraint' ); my $param_type = $anon_type->type_parameter; - isa_ok( $param_type, 'Mouse::Meta::TypeConstraint::Class' ); + isa_ok( $param_type, 'Mouse::Meta::TypeConstraint' ); } + +done_testing; diff --git a/t/040_type_constraints/015_enum.t b/t/040_type_constraints/015_enum.t index dab1d0a..756a13a 100644 --- a/t/040_type_constraints/015_enum.t +++ b/t/040_type_constraints/015_enum.t @@ -1,19 +1,22 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More 'no_plan'; +use Test::More; +$TODO = q{Mouse is not yet completed}; +use Test::Exception; use Scalar::Util (); -use lib 't/lib'; use Mouse::Util::TypeConstraints; -use MooseCompat; enum Letter => 'a'..'z', 'A'..'Z'; enum Language => 'Perl 5', 'Perl 6', 'PASM', 'PIR'; # any others? ;) -enum Metacharacter => '*', '+', '?', '.', '|', '(', ')', '[', ']', '\\'; +enum Metacharacter => ['*', '+', '?', '.', '|', '(', ')', '[', ']', '\\']; my @valid_letters = ('a'..'z', 'A'..'Z'); @@ -47,19 +50,46 @@ ok(!Metacharacter($_), "'$_' is not a metacharacter") my $anon_enum = enum \@valid_languages; isa_ok($anon_enum, 'Mouse::Meta::TypeConstraint'); -#is($anon_enum->name, '__ANON__', '... got the right name'); -#is($anon_enum->parent->name, 'Str', '... got the right parent name'); +is($anon_enum->name, '__ANON__', '... got the right name'); +is($anon_enum->parent->name, 'Str', '... got the right parent name'); ok($anon_enum->check($_), "'$_' is a language") for @valid_languages; -#ok( !$anon_enum->equals( enum [qw(foo bar)] ), "doesn't equal a diff enum" ); -#ok( $anon_enum->equals( $anon_enum ), "equals itself" ); -#ok( $anon_enum->equals( enum \@valid_languages ), "equals duplicate" ); +ok( !$anon_enum->equals( enum [qw(foo bar)] ), "doesn't equal a diff enum" ); +ok( $anon_enum->equals( $anon_enum ), "equals itself" ); +ok( $anon_enum->equals( enum \@valid_languages ), "equals duplicate" ); -#ok( !$anon_enum->is_subtype_of('Object'), 'enum not a subtype of Object'); +ok( !$anon_enum->is_subtype_of('Object'), 'enum not a subtype of Object'); ok( !$anon_enum->is_a_type_of('Object'), 'enum not type of Object'); -#ok( !$anon_enum->is_subtype_of('ThisTypeDoesNotExist'), 'enum not a subtype of nonexistant type'); +ok( !$anon_enum->is_subtype_of('ThisTypeDoesNotExist'), 'enum not a subtype of nonexistant type'); ok( !$anon_enum->is_a_type_of('ThisTypeDoesNotExist'), 'enum not type of nonexistant type'); +# validation +throws_ok { Mouse::Meta::TypeConstraint->new(name => 'ZeroValues', values => []) } + qr/You must have at least two values to enumerate through/; + +throws_ok { Mouse::Meta::TypeConstraint->new(name => 'OneValue', values => [ 'a' ]) } + qr/You must have at least two values to enumerate through/; + +throws_ok { Mouse::Meta::TypeConstraint->new(name => 'ReferenceInEnum', values => [ 'a', {} ]) } + qr/Enum values must be strings, not 'HASH\(0x\w+\)'/; + +throws_ok { Mouse::Meta::TypeConstraint->new(name => 'UndefInEnum', values => [ 'a', undef ]) } + qr/Enum values must be strings, not undef/; + +throws_ok { + package Foo; + use Mouse; + use Mouse::Util::TypeConstraints; + + has error => ( + is => 'ro', + isa => enum ['a', 'aa', 'aaa'], # should be parenthesized! + default => 'aa', + ); +} qr/enum called with an array reference and additional arguments\. Did you mean to parenthesize the enum call's parameters\?/; + + +done_testing; diff --git a/t/040_type_constraints/017_subtyping_union_types.t b/t/040_type_constraints/017_subtyping_union_types.t index 830f1e8..ee79d50 100644 --- a/t/040_type_constraints/017_subtyping_union_types.t +++ b/t/040_type_constraints/017_subtyping_union_types.t @@ -1,9 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 19; +use Test::More; use Test::Exception; BEGIN { @@ -21,7 +24,7 @@ lives_ok { is($t->name, 'MyCollections', '... name is correct'); my $p = $t->parent; -# isa_ok($p, 'Mouse::Meta::TypeConstraint::Union'); + isa_ok($p, 'Mouse::Meta::TypeConstraint'); isa_ok($p, 'Mouse::Meta::TypeConstraint'); is($p->name, 'ArrayRef|HashRef', '... parent name is correct'); @@ -52,7 +55,7 @@ lives_ok { is($t->name, 'MyCollectionsExtended', '... name is correct'); my $p = $t->parent; -# isa_ok($p, 'Mouse::Meta::TypeConstraint::Union'); + isa_ok($p, 'Mouse::Meta::TypeConstraint'); isa_ok($p, 'Mouse::Meta::TypeConstraint'); is($p->name, 'ArrayRef|HashRef', '... parent name is correct'); @@ -66,4 +69,4 @@ lives_ok { ok(!$t->check(1), '... validated it correctly'); } - +done_testing; diff --git a/t/040_type_constraints/failing/018_custom_parameterized_types.t b/t/040_type_constraints/018_custom_parameterized_types.t similarity index 77% rename from t/040_type_constraints/failing/018_custom_parameterized_types.t rename to t/040_type_constraints/018_custom_parameterized_types.t index c00bda9..5dad083 100644 --- a/t/040_type_constraints/failing/018_custom_parameterized_types.t +++ b/t/040_type_constraints/018_custom_parameterized_types.t @@ -1,14 +1,18 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 28; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; BEGIN { use_ok("Mouse::Util::TypeConstraints"); - use_ok('Mouse::Meta::TypeConstraint::Parameterized'); + use_ok('Mouse::Meta::TypeConstraint'); } lives_ok { @@ -58,8 +62,8 @@ ok(!$hoi->check({ one1 => 'un', two2 => 'deux' }), '... validated it correctly') ok( $hoi->equals($hoi), "equals to self" ); ok( !$hoi->equals($hoi->parent), "equals to self" ); ok( !$hoi->equals(find_type_constraint('AlphaKeyHash')), "not equal to unparametrized self" ); -ok( $hoi->equals( Mouse::Meta::TypeConstraint::Parameterized->new( name => "Blah", parent => find_type_constraint("AlphaKeyHash"), type_parameter => find_type_constraint("Int") ) ), "equal to clone" ); -ok( !$hoi->equals( Mouse::Meta::TypeConstraint::Parameterized->new( name => "Oink", parent => find_type_constraint("AlphaKeyHash"), type_parameter => find_type_constraint("Str") ) ), "not equal to different parameter" ); +ok( $hoi->equals( Mouse::Meta::TypeConstraint->new( name => "Blah", parent => find_type_constraint("AlphaKeyHash"), type_parameter => find_type_constraint("Int") ) ), "equal to clone" ); +ok( !$hoi->equals( Mouse::Meta::TypeConstraint->new( name => "Oink", parent => find_type_constraint("AlphaKeyHash"), type_parameter => find_type_constraint("Str") ) ), "not equal to different parameter" ); my $th = Mouse::Util::TypeConstraints::find_or_parse_type_constraint('Trihash[Bool]'); @@ -69,7 +73,7 @@ ok(!$th->check({ one => 1, two => 2, three => 1 }), '... validated it correctly' ok(!$th->check({foo1 => 1, bar2 => 0, baz3 => 1}), '... validated it correctly'); dies_ok { - Mouse::Meta::TypeConstraint::Parameterized->new( + Mouse::Meta::TypeConstraint->new( name => 'Str[Int]', parent => find_type_constraint('Str'), type_parameter => find_type_constraint('Int'), @@ -77,10 +81,11 @@ dies_ok { } 'non-containers cannot be parameterized'; dies_ok { - Mouse::Meta::TypeConstraint::Parameterized->new( + Mouse::Meta::TypeConstraint->new( name => 'Noncon[Int]', parent => find_type_constraint('Noncon'), type_parameter => find_type_constraint('Int'), ); } 'non-containers cannot be parameterized'; +done_testing; diff --git a/t/040_type_constraints/022_custom_type_errors.t b/t/040_type_constraints/022_custom_type_errors.t index 38757e7..8638620 100644 --- a/t/040_type_constraints/022_custom_type_errors.t +++ b/t/040_type_constraints/022_custom_type_errors.t @@ -1,9 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 9; +use Test::More; use Test::Exception; { @@ -57,3 +60,4 @@ throws_ok { $gimp->leg_count } qr/This number \(0\) is not less than ten!/, 'gave custom supertype error message on lazy set to 0'; +done_testing; diff --git a/t/040_type_constraints/023_types_and_undef.t b/t/040_type_constraints/023_types_and_undef.t index f276688..2818774 100644 --- a/t/040_type_constraints/023_types_and_undef.t +++ b/t/040_type_constraints/023_types_and_undef.t @@ -1,12 +1,14 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 54; +use Test::More; use Test::Exception; -use t::lib::MooseCompat; { package Foo; @@ -42,28 +44,28 @@ Mouse::Util::TypeConstraints->export_type_constraints_as_functions; ok( Undef(undef), '... undef is a Undef'); ok(!Defined(undef), '... undef is NOT a Defined'); -ok(!Int(undef), '... undef is NOT a Int'); +ok(!Int(undef), '... undef is NOT an Int'); ok(!Number(undef), '... undef is NOT a Number'); ok(!Str(undef), '... undef is NOT a Str'); ok(!String(undef), '... undef is NOT a String'); ok(!Undef(5), '... 5 is a NOT a Undef'); ok(Defined(5), '... 5 is a Defined'); -ok(Int(5), '... 5 is a Int'); +ok(Int(5), '... 5 is an Int'); ok(Number(5), '... 5 is a Number'); ok(Str(5), '... 5 is a Str'); ok(!String(5), '... 5 is NOT a String'); ok(!Undef(0.5), '... 0.5 is a NOT a Undef'); ok(Defined(0.5), '... 0.5 is a Defined'); -ok(!Int(0.5), '... 0.5 is NOT a Int'); +ok(!Int(0.5), '... 0.5 is NOT an Int'); ok(Number(0.5), '... 0.5 is a Number'); ok(Str(0.5), '... 0.5 is a Str'); ok(!String(0.5), '... 0.5 is NOT a String'); ok(!Undef('Foo'), '... "Foo" is NOT a Undef'); ok(Defined('Foo'), '... "Foo" is a Defined'); -ok(!Int('Foo'), '... "Foo" is NOT a Int'); +ok(!Int('Foo'), '... "Foo" is NOT an Int'); ok(!Number('Foo'), '... "Foo" is NOT a Number'); ok(Str('Foo'), '... "Foo" is a Str'); ok(String('Foo'), '... "Foo" is a String'); @@ -108,6 +110,4 @@ dies_ok { $foo->v_lazy_Number() } '... undef is NOT a Foo->Number'; dies_ok { $foo->v_lazy_Str() } '... undef is NOT a Foo->Str'; dies_ok { $foo->v_lazy_String() } '... undef is NOT a Foo->String'; - - - +done_testing; diff --git a/t/040_type_constraints/025_type_coersion_on_lazy_attributes.t b/t/040_type_constraints/025_type_coersion_on_lazy_attributes.t index 9400f1a..23b0026 100644 --- a/t/040_type_constraints/025_type_coersion_on_lazy_attributes.t +++ b/t/040_type_constraints/025_type_coersion_on_lazy_attributes.t @@ -1,9 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 1; +use Test::More; { package SomeClass; @@ -14,7 +17,6 @@ use Test::More tests => 1; => where { /^6$/ }; subtype 'TextSix' => as 'Str' => where { /Six/i }; - coerce 'TextSix' => from 'DigitSix' => via { confess("Cannot live without 6 ($_)") unless /^6$/; 'Six' }; @@ -28,6 +30,8 @@ use Test::More tests => 1; ); } +my $attr = SomeClass->meta->get_attribute('foo'); +is($attr->get_value(SomeClass->new()), 'Six'); is(SomeClass->new()->foo, 'Six'); - +done_testing; diff --git a/t/040_type_constraints/failing/027_parameterize_from.t b/t/040_type_constraints/027_parameterize_from.t similarity index 83% rename from t/040_type_constraints/failing/027_parameterize_from.t rename to t/040_type_constraints/027_parameterize_from.t index 7ff3d0a..93e3040 100644 --- a/t/040_type_constraints/failing/027_parameterize_from.t +++ b/t/040_type_constraints/027_parameterize_from.t @@ -1,9 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 12; +use Test::More; use Test::Exception; BEGIN { @@ -22,10 +25,10 @@ BEGIN { my $from_parameterizable = $parameterizable->parameterize($int); isa_ok $parameterizable, - 'Mouse::Meta::TypeConstraint::Parameterizable', => + 'Mouse::Meta::TypeConstraint', => 'Got expected type instance'; - package Test::Mouse::Meta::TypeConstraint::Parameterizable; + package Test::Mouse::Meta::TypeConstraint; use Mouse; has parameterizable => ( is => 'rw', isa => $parameterizable ); @@ -35,10 +38,10 @@ BEGIN { # Create and check a dummy object -ok my $params = Test::Mouse::Meta::TypeConstraint::Parameterizable->new() => +ok my $params = Test::Mouse::Meta::TypeConstraint->new() => 'Create Dummy object for testing'; -isa_ok $params, 'Test::Mouse::Meta::TypeConstraint::Parameterizable' => +isa_ok $params, 'Test::Mouse::Meta::TypeConstraint' => 'isa correct type'; # test parameterizable @@ -77,3 +80,5 @@ throws_ok sub { }, qr/Attribute \(from_parameterizable\) does not pass the type constraint/ => 'from_parameterizable throws expected error'; + +done_testing; diff --git a/t/040_type_constraints/029_define_type_twice_throws.t b/t/040_type_constraints/029_define_type_twice_throws.t index 67bc3ae..5dcb88c 100644 --- a/t/040_type_constraints/029_define_type_twice_throws.t +++ b/t/040_type_constraints/029_define_type_twice_throws.t @@ -1,9 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 2; +use Test::More; use Test::Exception; BEGIN { @@ -24,3 +27,4 @@ throws_ok { subtype 'MySubType' => as 'Int' => where { 1 }; } qr/cannot be created again/, 'Trying to create same type twice throws'; +done_testing; diff --git a/t/040_type_constraints/failing/031_subtype_auto_vivify_parent.t b/t/040_type_constraints/031_subtype_auto_vivify_parent.t similarity index 69% rename from t/040_type_constraints/failing/031_subtype_auto_vivify_parent.t rename to t/040_type_constraints/031_subtype_auto_vivify_parent.t index e245ab8..e127ac1 100644 --- a/t/040_type_constraints/failing/031_subtype_auto_vivify_parent.t +++ b/t/040_type_constraints/031_subtype_auto_vivify_parent.t @@ -1,9 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 4; +use Test::More; use Mouse::Util::TypeConstraints; @@ -27,5 +30,7 @@ my $type = find_type_constraint('FooWithSize'); ok( $type, 'made a FooWithSize constraint' ); ok( $type->parent, 'type has a parent type' ); is( $type->parent->name, 'Foo', 'parent type is Foo' ); -isa_ok( $type->parent, 'Mouse::Meta::TypeConstraint::Class', +isa_ok( $type->parent, 'Mouse::Meta::TypeConstraint', 'parent type constraint is a class type' ); + +done_testing; diff --git a/t/040_type_constraints/032_throw_error.t b/t/040_type_constraints/032_throw_error.t new file mode 100644 index 0000000..1da2535 --- /dev/null +++ b/t/040_type_constraints/032_throw_error.t @@ -0,0 +1,18 @@ +use strict; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use warnings; + +use Test::More; +$TODO = q{Mouse is not yet completed}; + +use Mouse::Util::TypeConstraints; + + +eval { Mouse::Util::TypeConstraints::create_type_constraint_union() }; + +like( $@, qr/\QYou must pass in at least 2 type names to make a union/, + 'can throw a proper error without Mouse being loaded by the caller' ); + +done_testing; diff --git a/t/040_type_constraints/failing/034_duck_types.t b/t/040_type_constraints/034_duck_types.t similarity index 86% rename from t/040_type_constraints/failing/034_duck_types.t rename to t/040_type_constraints/034_duck_types.t index e5b467b..5eb1093 100644 --- a/t/040_type_constraints/failing/034_duck_types.t +++ b/t/040_type_constraints/034_duck_types.t @@ -1,8 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 5; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; { @@ -78,3 +82,5 @@ lives_ok { DucktypeTest->new( duck => RubberDuck->new ) } # try with the other constraint form lives_ok { DucktypeTest->new( other_swan => Swan->new ) } 'but a Swan can honk'; + +done_testing; diff --git a/t/040_type_constraints/failing/032_throw_error.t b/t/040_type_constraints/failing/032_throw_error.t deleted file mode 100644 index d9c992b..0000000 --- a/t/040_type_constraints/failing/032_throw_error.t +++ /dev/null @@ -1,12 +0,0 @@ -use strict; -use warnings; - -use Test::More tests => 1; - -use Mouse::Util::TypeConstraints; - - -eval { Mouse::Util::TypeConstraints::create_type_constraint_union() }; - -like( $@, qr/\QYou must pass in at least 2 type names to make a union/, - 'can throw a proper error without Mouse being loaded by the caller' ); diff --git a/t/050_metaclasses/001_custom_attr_meta_with_roles.t b/t/050_metaclasses/001_custom_attr_meta_with_roles.t index 613e0f9..4e5feb4 100644 --- a/t/050_metaclasses/001_custom_attr_meta_with_roles.t +++ b/t/050_metaclasses/001_custom_attr_meta_with_roles.t @@ -1,13 +1,15 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 3; +use Test::More; use Test::Exception; - { package My::Custom::Meta::Attr; use Mouse; @@ -40,4 +42,4 @@ ok($c->meta->has_attribute('bling_bling'), '... got the attribute'); isa_ok($c->meta->get_attribute('bling_bling'), 'My::Custom::Meta::Attr'); - +done_testing; diff --git a/t/050_metaclasses/002_custom_attr_meta_as_role.t b/t/050_metaclasses/002_custom_attr_meta_as_role.t index 106f19c..bf3d0e3 100644 --- a/t/050_metaclasses/002_custom_attr_meta_as_role.t +++ b/t/050_metaclasses/002_custom_attr_meta_as_role.t @@ -1,15 +1,16 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 2; +use Test::More; use Test::Exception; -; - lives_ok { - package MouseX::Attribute::Test; + package MooseX::Attribute::Test; use Mouse::Role; } 'creating custom attribute "metarole" is okay'; @@ -18,5 +19,7 @@ lives_ok { use Mouse; extends 'Mouse::Meta::Attribute'; - with 'MouseX::Attribute::Test'; + with 'MooseX::Attribute::Test'; } 'custom attribute metaclass extending role is okay'; + +done_testing; diff --git a/t/050_metaclasses/failing/004_moose_for_meta.t b/t/050_metaclasses/004_moose_for_meta.t similarity index 86% rename from t/050_metaclasses/failing/004_moose_for_meta.t rename to t/050_metaclasses/004_moose_for_meta.t index 21d3a9a..aa37b04 100644 --- a/t/050_metaclasses/failing/004_moose_for_meta.t +++ b/t/050_metaclasses/004_moose_for_meta.t @@ -1,13 +1,15 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 16; +use Test::More; use Test::Exception; - =pod This test demonstrates the ability to extend @@ -33,7 +35,7 @@ Mouse meta-level classes using Mouse itself. my $anon = My::Meta::Class->create_anon_class(); isa_ok($anon, 'My::Meta::Class'); isa_ok($anon, 'Mouse::Meta::Class'); -isa_ok($anon, 'Class::MOP::Class'); +isa_ok($anon, 'Mouse::Meta::Class'); is_deeply( [ $anon->superclasses ], @@ -59,7 +61,7 @@ is_deeply( my $attr = My::Meta::Attribute::DefaultReadOnly->new('foo'); isa_ok($attr, 'My::Meta::Attribute::DefaultReadOnly'); isa_ok($attr, 'Mouse::Meta::Attribute'); - isa_ok($attr, 'Class::MOP::Attribute'); + isa_ok($attr, 'Mouse::Meta::Attribute'); ok($attr->has_reader, '... the attribute has a reader (as expected)'); ok(!$attr->has_writer, '... the attribute does not have a writer (as expected)'); @@ -70,10 +72,11 @@ is_deeply( my $attr = My::Meta::Attribute::DefaultReadOnly->new('foo', (is => 'rw')); isa_ok($attr, 'My::Meta::Attribute::DefaultReadOnly'); isa_ok($attr, 'Mouse::Meta::Attribute'); - isa_ok($attr, 'Class::MOP::Attribute'); + isa_ok($attr, 'Mouse::Meta::Attribute'); ok(!$attr->has_reader, '... the attribute does not have a reader (as expected)'); ok(!$attr->has_writer, '... the attribute does not have a writer (as expected)'); ok($attr->has_accessor, '... the attribute does have an accessor (as expected)'); } +done_testing; diff --git a/t/050_metaclasses/011_init_meta.t b/t/050_metaclasses/011_init_meta.t deleted file mode 100644 index 9755f85..0000000 --- a/t/050_metaclasses/011_init_meta.t +++ /dev/null @@ -1,16 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; - -use Test::More tests => 4; - -use Mouse (); - -my $meta = Mouse->init_meta(for_class => 'Foo'); - -ok( Foo->isa('Mouse::Object'), '... Foo isa Mouse::Object'); -isa_ok( $meta, 'Mouse::Meta::Class' ); -isa_ok( Foo->meta, 'Mouse::Meta::Class' ); - -is($meta, Foo->meta, '... our metas are the same'); diff --git a/t/050_metaclasses/failing/012_moose_exporter.t b/t/050_metaclasses/012_moose_exporter.t similarity index 82% rename from t/050_metaclasses/failing/012_moose_exporter.t rename to t/050_metaclasses/012_moose_exporter.t index 63126aa..39ac3ef 100644 --- a/t/050_metaclasses/failing/012_moose_exporter.t +++ b/t/050_metaclasses/012_moose_exporter.t @@ -1,16 +1,17 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; use Test::More; use Test::Exception; -BEGIN { - eval "use Test::Output;"; - plan skip_all => "Test::Output is required for this test" if $@; - plan tests => 65; -} +use Test::Requires { + 'Test::Output' => '0.01', # skip all if not installed +}; { package HasOwnImmutable; @@ -30,24 +31,24 @@ BEGIN { } { - package MouseX::Empty; + package MooseX::Empty; use Mouse (); Mouse::Exporter->setup_import_methods( also => 'Mouse' ); } { - package WantsMouse; + package WantsMoose; - MouseX::Empty->import(); + MooseX::Empty->import(); sub foo { 1 } - ::can_ok( 'WantsMouse', 'has' ); - ::can_ok( 'WantsMouse', 'with' ); - ::can_ok( 'WantsMouse', 'foo' ); + ::can_ok( 'WantsMoose', 'has' ); + ::can_ok( 'WantsMoose', 'with' ); + ::can_ok( 'WantsMoose', 'foo' ); - MouseX::Empty->unimport(); + MooseX::Empty->unimport(); } { @@ -56,18 +57,18 @@ BEGIN { # namespace::clean(0.08)-based solution, but had to abandon it # because it cleans the namespace _later_ (when the file scope # ends). - ok( ! WantsMouse->can('has'), 'WantsMouse::has() has been cleaned' ); - ok( ! WantsMouse->can('with'), 'WantsMouse::with() has been cleaned' ); - can_ok( 'WantsMouse', 'foo' ); + ok( ! WantsMoose->can('has'), 'WantsMoose::has() has been cleaned' ); + ok( ! WantsMoose->can('with'), 'WantsMoose::with() has been cleaned' ); + can_ok( 'WantsMoose', 'foo' ); # This makes sure that Mouse->init_meta() happens properly - isa_ok( WantsMouse->meta(), 'Mouse::Meta::Class' ); - isa_ok( WantsMouse->new(), 'Mouse::Object' ); + isa_ok( WantsMoose->meta(), 'Mouse::Meta::Class' ); + isa_ok( WantsMoose->new(), 'Mouse::Object' ); } { - package MouseX::Sugar; + package MooseX::Sugar; use Mouse (); @@ -85,7 +86,7 @@ BEGIN { { package WantsSugar; - MouseX::Sugar->import(); + MooseX::Sugar->import(); sub foo { 1 } @@ -96,7 +97,7 @@ BEGIN { ::is( wrapped1(), 'WantsSugar called wrapped1', 'wrapped1 identifies the caller correctly' ); - MouseX::Sugar->unimport(); + MooseX::Sugar->unimport(); } { @@ -107,12 +108,12 @@ BEGIN { } { - package MouseX::MoreSugar; + package MooseX::MoreSugar; use Mouse (); sub wrapped2 { - my $caller = shift; + my $caller = shift->name; return $caller . ' called wrapped2'; } @@ -121,16 +122,16 @@ BEGIN { } Mouse::Exporter->setup_import_methods( - with_caller => ['wrapped2'], - as_is => ['as_is1'], - also => 'MouseX::Sugar', + with_meta => ['wrapped2'], + as_is => ['as_is1'], + also => 'MooseX::Sugar', ); } { package WantsMoreSugar; - MouseX::MoreSugar->import(); + MooseX::MoreSugar->import(); sub foo { 1 } @@ -147,7 +148,7 @@ BEGIN { ::is( as_is1(), 'as_is1', 'as_is1 works as expected' ); - MouseX::MoreSugar->unimport(); + MooseX::MoreSugar->unimport(); } { @@ -195,14 +196,14 @@ BEGIN { } { - package MouseX::CircularAlso; + package MooseX::CircularAlso; use Mouse (); ::dies_ok( sub { Mouse::Exporter->setup_import_methods( - also => [ 'Mouse', 'MouseX::CircularAlso' ], + also => [ 'Mouse', 'MooseX::CircularAlso' ], ); }, 'a circular reference in also dies with an error' @@ -210,13 +211,13 @@ BEGIN { ::like( $@, - qr/\QCircular reference in 'also' parameter to Mouse::Exporter between MouseX::CircularAlso and MouseX::CircularAlso/, + qr/\QCircular reference in 'also' parameter to Mouse::Exporter between MooseX::CircularAlso and MooseX::CircularAlso/, 'got the expected error from circular reference in also' ); } { - package MouseX::NoAlso; + package MooseX::NoAlso; use Mouse (); @@ -237,7 +238,7 @@ BEGIN { } { - package MouseX::NotExporter; + package MooseX::NotExporter; use Mouse (); @@ -258,32 +259,32 @@ BEGIN { } { - package MouseX::OverridingSugar; + package MooseX::OverridingSugar; use Mouse (); sub has { - my $caller = shift; + my $caller = shift->name; return $caller . ' called has'; } Mouse::Exporter->setup_import_methods( - with_caller => ['has'], - also => 'Mouse', + with_meta => ['has'], + also => 'Mouse', ); } { package WantsOverridingSugar; - MouseX::OverridingSugar->import(); + MooseX::OverridingSugar->import(); ::can_ok( 'WantsOverridingSugar', 'has' ); ::can_ok( 'WantsOverridingSugar', 'with' ); ::is( has('foo'), 'WantsOverridingSugar called has', - 'has from MouseX::OverridingSugar is called, not has from Mouse' ); + 'has from MooseX::OverridingSugar is called, not has from Mouse' ); - MouseX::OverridingSugar->unimport(); + MooseX::OverridingSugar->unimport(); } { @@ -299,7 +300,7 @@ BEGIN { ::stderr_like { Mouse::Exporter->setup_import_methods( also => ['Mouse'], - with_caller => ['does_not_exist'], + with_meta => ['does_not_exist'], ); } qr/^Trying to export undefined sub NonExistentExport::does_not_exist/, "warns when a non-existent method is requested to be exported"; @@ -317,6 +318,7 @@ BEGIN { { package AllOptions; use Mouse (); + use Mouse::Deprecated -api_version => '0.88'; use Mouse::Exporter; Mouse::Exporter->setup_import_methods( @@ -389,3 +391,5 @@ BEGIN { ok( ! UseAllOptions->can($_), "UseAllOptions::$_ has been unimported" ) for qw( with_meta1 with_meta2 with_caller1 with_caller2 as_is1 ); } + +done_testing; diff --git a/t/050_metaclasses/013_metaclass_traits.t b/t/050_metaclasses/013_metaclass_traits.t index 06159a0..c04959f 100644 --- a/t/050_metaclasses/013_metaclass_traits.t +++ b/t/050_metaclasses/013_metaclass_traits.t @@ -1,11 +1,14 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; use lib 't/lib', 'lib'; -use Test::More tests => 32; +use Test::More; use Test::Exception; { @@ -173,7 +176,6 @@ is( Role::Foo->meta()->simple(), 5, '... and error provides a useful explanation' ); } - { package Foo::Subclass; @@ -221,3 +223,5 @@ lives_ok { is( $instance->an_attr, 'value', 'Can get value' ); } 'Can create instance and access attributes'; + +done_testing; diff --git a/t/050_metaclasses/017_use_base_of_moose.t b/t/050_metaclasses/017_use_base_of_moose.t index b8962bd..607a067 100644 --- a/t/050_metaclasses/017_use_base_of_moose.t +++ b/t/050_metaclasses/017_use_base_of_moose.t @@ -1,21 +1,22 @@ #!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 4; +use Test::More; use Test::Exception; { package NoOpTrait; use Mouse::Role; - - } { package Parent; - use Mouse "-traits" => 'NoOpTrait'; + use Mouse -traits => 'NoOpTrait'; has attr => ( is => 'rw', @@ -27,12 +28,15 @@ use Test::Exception; package Child; use base 'Parent'; } + is(Child->meta->name, 'Child', "correct metaclass name"); + my $child = Child->new(attr => "ibute"); ok($child, "constructor works"); - is($child->attr, "ibute", "getter inherited properly"); $child->attr("ition"); is($child->attr, "ition", "setter inherited properly"); + +done_testing; diff --git a/t/050_metaclasses/020_metaclass_parameterized_traits.t b/t/050_metaclasses/020_metaclass_parameterized_traits.t index a590605..b6544f9 100644 --- a/t/050_metaclasses/020_metaclass_parameterized_traits.t +++ b/t/050_metaclasses/020_metaclass_parameterized_traits.t @@ -1,8 +1,10 @@ #!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; - -use Test::More tests => 5; +use Test::More; { package My::Trait; @@ -46,3 +48,4 @@ is($other_meta->reversed, 'ssalC::rehtO::yM', 'parameterized trait applied'); ok(!$other_meta->can('enam'), "the method was not installed under the other class' alias"); ok(!$other_meta->can('reversed_name'), "the method was not installed under the original name when that was excluded"); +done_testing; diff --git a/t/050_metaclasses/failing/021_export_with_prototype.t b/t/050_metaclasses/021_export_with_prototype.t similarity index 61% rename from t/050_metaclasses/failing/021_export_with_prototype.t rename to t/050_metaclasses/021_export_with_prototype.t index 469585c..d18d3ba 100644 --- a/t/050_metaclasses/failing/021_export_with_prototype.t +++ b/t/050_metaclasses/021_export_with_prototype.t @@ -1,20 +1,26 @@ use lib "t/lib"; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; package MyExporter::User; use MyExporter; -use Test::More (tests => 4); +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; lives_and { with_prototype { my $caller = caller(0); - is($caller, 'MyExporter', "With_caller prototype code gets called from MyMouseX"); + is($caller, 'MyExporter', "With_caller prototype code gets called from MyMooseX"); }; } "check function with prototype"; lives_and { as_is_prototype { my $caller = caller(0); - is($caller, 'MyExporter', "As-is prototype code gets called from MyMouseX"); + is($caller, 'MyExporter', "As-is prototype code gets called from MyMooseX"); }; } "check function with prototype"; + +done_testing; diff --git a/t/050_metaclasses/failing/040_moose_nonmoose_metatrait_init_order.t b/t/050_metaclasses/040_moose_nonmoose_metatrait_init_order.t similarity index 75% rename from t/050_metaclasses/failing/040_moose_nonmoose_metatrait_init_order.t rename to t/050_metaclasses/040_moose_nonmoose_metatrait_init_order.t index 309937f..8e8d8cf 100644 --- a/t/050_metaclasses/failing/040_moose_nonmoose_metatrait_init_order.t +++ b/t/050_metaclasses/040_moose_nonmoose_metatrait_init_order.t @@ -1,4 +1,7 @@ use strict; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use warnings; { package My::Role; @@ -17,7 +20,8 @@ use warnings; use base qw/SubClassUseBase/; } -use Test::More tests => 2; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Mouse::Util qw/find_meta does_role/; my $subsubclass_meta = Mouse->init_meta( for_class => 'SubSubClassUseBase' ); @@ -26,3 +30,5 @@ ok does_role($subsubclass_meta, 'My::Role'), my $subclass_meta = find_meta('SubClassUseBase'); ok does_role($subclass_meta, 'My::Role'), 'SubClass metaclass does role from parent metaclass'; + +done_testing; diff --git a/t/050_metaclasses/041_moose_nonmoose_chain_init_meta.t b/t/050_metaclasses/041_moose_nonmoose_moose_chain_init_meta.t similarity index 67% rename from t/050_metaclasses/041_moose_nonmoose_chain_init_meta.t rename to t/050_metaclasses/041_moose_nonmoose_moose_chain_init_meta.t index 6df8fa7..9741e72 100644 --- a/t/050_metaclasses/041_moose_nonmoose_chain_init_meta.t +++ b/t/050_metaclasses/041_moose_nonmoose_moose_chain_init_meta.t @@ -1,8 +1,8 @@ use strict; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use warnings; -use Test::More tests => 1; -use Test::Exception; - { package ParentClass; use Mouse; @@ -17,6 +17,11 @@ use Test::Exception; use Mouse; } +use Test::More; +use Test::Exception; + lives_ok { Mouse->init_meta(for_class => 'SomeClass'); } 'Mouse class => use base => Mouse Class, then Mouse->init_meta on middle class ok'; + +done_testing; diff --git a/t/050_metaclasses/051_metarole_on_anon.t b/t/050_metaclasses/051_metarole_on_anon.t index f0ec101..7a79418 100644 --- a/t/050_metaclasses/051_metarole_on_anon.t +++ b/t/050_metaclasses/051_metarole_on_anon.t @@ -1,4 +1,7 @@ use strict; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use warnings; use Test::More; diff --git a/t/050_metaclasses/052_new_object_BUILD.t b/t/050_metaclasses/052_new_object_BUILD.t new file mode 100644 index 0000000..b3badc8 --- /dev/null +++ b/t/050_metaclasses/052_new_object_BUILD.t @@ -0,0 +1,23 @@ +#!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use strict; +use warnings; +use Test::More; + +my $called; +{ + package Foo; + use Mouse; + + sub BUILD { $called++ } +} + +Foo->new; +is($called, 1, "BUILD called from ->new"); +$called = 0; +Foo->meta->new_object; +is($called, 1, "BUILD called from ->meta->new_object"); + +done_testing; diff --git a/t/050_metaclasses/053_immutable_metaclass_compat_bug.t b/t/050_metaclasses/053_immutable_metaclass_compat_bug.t new file mode 100644 index 0000000..08d0c91 --- /dev/null +++ b/t/050_metaclasses/053_immutable_metaclass_compat_bug.t @@ -0,0 +1,41 @@ +#!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use strict; +use warnings; +use Test::More; + +{ + package Foo::Base::Meta::Trait; + use Mouse::Role; +} + +{ + package Foo::Base; + use Mouse; + Mouse::Util::MetaRole::apply_metaroles( + for => __PACKAGE__, + class_metaroles => { constructor => ['Foo::Base::Meta::Trait'] }, + ); + __PACKAGE__->meta->make_immutable; +} + +{ + package Foo::Meta::Trait; + use Mouse::Role; +} + +{ + package Foo; + use Mouse; + Mouse::Util::MetaRole::apply_metaroles( + for => __PACKAGE__, + class_metaroles => { constructor => ['Foo::Meta::Trait'] } + ); + ::ok(!Foo->meta->is_immutable); + extends 'Foo::Base'; + ::ok(!Foo->meta->is_immutable); +} + +done_testing; diff --git a/t/050_metaclasses/054_metaclass_compat_no_fixing_bug.t b/t/050_metaclasses/054_metaclass_compat_no_fixing_bug.t new file mode 100644 index 0000000..3fadb21 --- /dev/null +++ b/t/050_metaclasses/054_metaclass_compat_no_fixing_bug.t @@ -0,0 +1,49 @@ +#!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use strict; +use warnings; +use Test::More; +use Test::Exception; + +{ + package Foo::Meta::Constructor1; + use Mouse::Role; +} + +{ + package Foo::Meta::Constructor2; + use Mouse::Role; +} + +{ + package Foo; + use Mouse; + Mouse::Util::MetaRole::apply_metaroles( + for => __PACKAGE__, + class_metaroles => { constructor => ['Foo::Meta::Constructor1'] }, + ); +} + +{ + package Foo::Sub; + use Mouse; + Mouse::Util::MetaRole::apply_metaroles( + for => __PACKAGE__, + class_metaroles => { constructor => ['Foo::Meta::Constructor2'] }, + ); + extends 'Foo'; +} + +{ + package Foo::Sub::Sub; + use Mouse; + Mouse::Util::MetaRole::apply_metaroles( + for => __PACKAGE__, + class_metaroles => { constructor => ['Foo::Meta::Constructor2'] }, + ); + ::lives_ok { extends 'Foo::Sub' } "doesn't try to fix if nothing is needed"; +} + +done_testing; diff --git a/t/060_compat/001_module_refresh_compat.t b/t/060_compat/001_module_refresh_compat.t new file mode 100644 index 0000000..fe07218 --- /dev/null +++ b/t/060_compat/001_module_refresh_compat.t @@ -0,0 +1,95 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use lib 't/lib', 'lib'; + +use Test::More; +use Test::Exception; + +use File::Spec; +use File::Temp 'tempdir'; + +use Test::Requires { + 'Module::Refresh' => '0.01', # skip all if not installed +}; + +=pod + +First lets test some of our simple example modules ... + +=cut + +my @modules = qw[Foo Bar MyMooseA MyMooseB MyMooseObject]; + +do { + use_ok($_); + + is($_->meta->name, $_, '... initialized the meta correctly'); + + lives_ok { + Module::Refresh->new->refresh_module($_ . '.pm') + } '... successfully refreshed ' . $_; +} foreach @modules; + +=pod + +Now, lets try something a little trickier +and actually change the module itself. + +=cut + +my $dir = tempdir( "MooseTest-XXXXX", CLEANUP => 1, TMPDIR => 1 ); +push @INC, $dir; + +my $test_module_file = File::Spec->catdir($dir, 'TestBaz.pm'); + +my $test_module_source_1 = q| +package TestBaz; +use Mouse; +has 'foo' => (is => 'ro', isa => 'Int'); +1; +|; + +my $test_module_source_2 = q| +package TestBaz; +use Mouse; +extends 'Foo'; +has 'foo' => (is => 'rw', isa => 'Int'); +1; +|; + +{ + open FILE, ">", $test_module_file + || die "Could not open $test_module_file because $!"; + print FILE $test_module_source_1; + close FILE; +} + +use_ok('TestBaz'); +is(TestBaz->meta->name, 'TestBaz', '... initialized the meta correctly'); +ok(TestBaz->meta->has_attribute('foo'), '... it has the foo attribute as well'); +ok(!TestBaz->isa('Foo'), '... TestBaz is not a Foo'); + +{ + open FILE, ">", $test_module_file + || die "Could not open $test_module_file because $!"; + print FILE $test_module_source_2; + close FILE; +} + +lives_ok { + Module::Refresh->new->refresh_module('TestBaz.pm') +} '... successfully refreshed ' . $test_module_file; + +is(TestBaz->meta->name, 'TestBaz', '... initialized the meta correctly'); +ok(TestBaz->meta->has_attribute('foo'), '... it has the foo attribute as well'); +ok(TestBaz->isa('Foo'), '... TestBaz is a Foo'); + +unlink $test_module_file; + +done_testing; diff --git a/t/060_compat/002_moose_respects_base.t b/t/060_compat/002_moose_respects_base.t new file mode 100644 index 0000000..ccdfa74 --- /dev/null +++ b/t/060_compat/002_moose_respects_base.t @@ -0,0 +1,53 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; +$TODO = q{Mouse is not yet completed}; +use Test::Exception; + + +=pod + +This test demonstrates that Mouse will respect +a previously set @ISA using use base, and not +try to add Mouse::Object to it. + +However, this is extremely order sensitive as +this test also demonstrates. + +=cut + +{ + package Foo; + use strict; + use warnings; + + sub foo { 'Foo::foo' } + + package Bar; + use base 'Foo'; + use Mouse; + + sub new { (shift)->meta->new_object(@_) } + + package Baz; + use Mouse; + use base 'Foo'; +} + +my $bar = Bar->new; +isa_ok($bar, 'Bar'); +isa_ok($bar, 'Foo'); +ok(!$bar->isa('Mouse::Object'), '... Bar is not Mouse::Object subclass'); + +my $baz = Baz->new; +isa_ok($baz, 'Baz'); +isa_ok($baz, 'Foo'); +isa_ok($baz, 'Mouse::Object'); + +done_testing; diff --git a/t/070_native_traits/010_array_from_role.t b/t/070_native_traits/010_array_from_role.t new file mode 100644 index 0000000..f19eee5 --- /dev/null +++ b/t/070_native_traits/010_array_from_role.t @@ -0,0 +1,49 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; +use Test::Exception; + +{ + package Foo; + use Mouse; + + has 'bar' => ( is => 'rw' ); + + package Stuffed::Role; + use Mouse::Role; + + has 'options' => ( + traits => ['Array'], + is => 'ro', + isa => 'ArrayRef[Foo]', + ); + + package Bulkie::Role; + use Mouse::Role; + + has 'stuff' => ( + traits => ['Array'], + is => 'ro', + isa => 'ArrayRef', + handles => { + get_stuff => 'get', + } + ); + + package Stuff; + use Mouse; + + ::lives_ok{ with 'Stuffed::Role'; + } '... this should work correctly'; + + ::lives_ok{ with 'Bulkie::Role'; + } '... this should work correctly'; +} + +done_testing; diff --git a/t/070_native_traits/020_remove_attribute.t b/t/070_native_traits/020_remove_attribute.t new file mode 100644 index 0000000..670b067 --- /dev/null +++ b/t/070_native_traits/020_remove_attribute.t @@ -0,0 +1,55 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; +$TODO = q{Mouse is not yet completed}; +use Test::Exception; + +{ + package MyHomePage; + use Mouse; + + has 'counter' => ( + traits => ['Counter'], + is => 'ro', + isa => 'Int', + default => 0, + handles => { + inc_counter => 'inc', + dec_counter => 'dec', + reset_counter => 'reset', + } + ); +} + +my $page = MyHomePage->new(); +isa_ok( $page, 'MyHomePage' ); + +can_ok( $page, $_ ) for qw[ + counter + dec_counter + inc_counter + reset_counter +]; + +lives_ok { + $page->meta->remove_attribute('counter'); +} +'... removed the counter attribute okay'; + +ok( !$page->meta->has_attribute('counter'), + '... no longer has the attribute' ); + +ok( !$page->can($_), "... our class no longer has the $_ method" ) for qw[ + counter + dec_counter + inc_counter + reset_counter +]; + +done_testing; diff --git a/t/070_native_traits/100_collection_with_roles.t b/t/070_native_traits/100_collection_with_roles.t new file mode 100644 index 0000000..75092ab --- /dev/null +++ b/t/070_native_traits/100_collection_with_roles.t @@ -0,0 +1,127 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; + +{ + package Subject; + + use Mouse::Role; + + has observers => ( + traits => ['Array'], + is => 'ro', + isa => 'ArrayRef[Observer]', + auto_deref => 1, + default => sub { [] }, + handles => { + 'add_observer' => 'push', + 'count_observers' => 'count', + }, + ); + + sub notify { + my ($self) = @_; + foreach my $observer ( $self->observers() ) { + $observer->update($self); + } + } +} + +{ + package Observer; + + use Mouse::Role; + + requires 'update'; +} + +{ + package Counter; + + use Mouse; + + with 'Subject'; + + has count => ( + traits => ['Counter'], + is => 'ro', + isa => 'Int', + default => 0, + handles => { + inc_counter => 'inc', + dec_counter => 'dec', + }, + ); + + after qw(inc_counter dec_counter) => sub { + my ($self) = @_; + $self->notify(); + }; +} + +{ + + package Display; + + use Test::More; + + use Mouse; + + with 'Observer'; + + sub update { + my ( $self, $subject ) = @_; + like $subject->count, qr{^-?\d+$}, + 'Observed number ' . $subject->count; + } +} + +package main; + +my $count = Counter->new(); + +ok( $count->can('add_observer'), 'add_observer method added' ); + +ok( $count->can('count_observers'), 'count_observers method added' ); + +ok( $count->can('inc_counter'), 'inc_counter method added' ); + +ok( $count->can('dec_counter'), 'dec_counter method added' ); + +$count->add_observer( Display->new() ); + +is( $count->count_observers, 1, 'Only one observer' ); + +is( $count->count, 0, 'Default to zero' ); + +$count->inc_counter; + +is( $count->count, 1, 'Increment to one ' ); + +$count->inc_counter for ( 1 .. 6 ); + +is( $count->count, 7, 'Increment up to seven' ); + +$count->dec_counter; + +is( $count->count, 6, 'Decrement to 6' ); + +$count->dec_counter for ( 1 .. 5 ); + +is( $count->count, 1, 'Decrement to 1' ); + +$count->dec_counter for ( 1 .. 2 ); + +is( $count->count, -1, 'Negative numbers' ); + +$count->inc_counter; + +is( $count->count, 0, 'Back to zero' ); + +done_testing; diff --git a/t/070_native_traits/201_trait_counter.t b/t/070_native_traits/201_trait_counter.t new file mode 100644 index 0000000..a8e9bfa --- /dev/null +++ b/t/070_native_traits/201_trait_counter.t @@ -0,0 +1,83 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; +$TODO = q{Mouse is not yet completed}; +use Test::Mouse 'does_ok'; + +{ + package MyHomePage; + use Mouse; + + has 'counter' => ( + traits => ['Counter'], + is => 'ro', + isa => 'Int', + default => 0, + handles => { + inc_counter => 'inc', + dec_counter => 'dec', + reset_counter => 'reset', + set_counter => 'set' + } + ); +} + +my $page = MyHomePage->new(); +isa_ok( $page, 'MyHomePage' ); + +can_ok( $page, $_ ) for qw[ + dec_counter + inc_counter + reset_counter + set_counter +]; + +is( $page->counter, 0, '... got the default value' ); + +$page->inc_counter; +is( $page->counter, 1, '... got the incremented value' ); + +$page->inc_counter; +is( $page->counter, 2, '... got the incremented value (again)' ); + +$page->dec_counter; +is( $page->counter, 1, '... got the decremented value' ); + +$page->reset_counter; +is( $page->counter, 0, '... got the original value' ); + +$page->set_counter(5); +is( $page->counter, 5, '... set the value' ); + +$page->inc_counter(2); +is( $page->counter, 7, '... increment by arg' ); + +$page->dec_counter(5); +is( $page->counter, 2, '... decrement by arg' ); + +# check the meta .. + +my $counter = $page->meta->get_attribute('counter'); +does_ok( $counter, 'Mouse::Meta::Attribute::Native::Trait::Counter' ); + +is( $counter->type_constraint->name, 'Int', + '... got the expected type constraint' ); + +is_deeply( + $counter->handles, + { + inc_counter => 'inc', + dec_counter => 'dec', + reset_counter => 'reset', + set_counter => 'set' + }, + '... got the right handles methods' +); + +done_testing; diff --git a/t/070_native_traits/202_trait_array.t b/t/070_native_traits/202_trait_array.t new file mode 100644 index 0000000..ad3ee28 --- /dev/null +++ b/t/070_native_traits/202_trait_array.t @@ -0,0 +1,278 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; +$TODO = q{Mouse is not yet completed}; +use Test::Exception; +use Test::Mouse 'does_ok'; + +my $sort; + +{ + + package Stuff; + use Mouse; + + has 'options' => ( + traits => ['Array'], + is => 'ro', + isa => 'ArrayRef[Str]', + default => sub { [] }, + handles => { + 'add_options' => 'push', + 'remove_last_option' => 'pop', + 'remove_first_option' => 'shift', + 'insert_options' => 'unshift', + 'get_option_at' => 'get', + 'set_option_at' => 'set', + 'num_options' => 'count', + 'has_no_options' => 'is_empty', + 'clear_options' => 'clear', + 'splice_options' => 'splice', + 'sort_options_in_place' => 'sort_in_place', + 'option_accessor' => 'accessor', + 'add_options_with_speed' => + [ 'push' => 'funrolls', 'funbuns' ], + 'prepend_prerequisites_along_with' => + [ 'unshift' => 'first', 'second' ], + 'descending_options' => + [ 'sort_in_place' => ($sort = sub { $_[1] <=> $_[0] }) ], + } + ); +} + +my $stuff = Stuff->new( options => [ 10, 12 ] ); +isa_ok( $stuff, 'Stuff' ); + +can_ok( $stuff, $_ ) for qw[ + add_options + remove_last_option + remove_first_option + insert_options + get_option_at + set_option_at + num_options + clear_options + has_no_options + sort_options_in_place + option_accessor +]; + +is_deeply( $stuff->options, [ 10, 12 ], '... got options' ); + +ok( !$stuff->has_no_options, '... we have options' ); +is( $stuff->num_options, 2, '... got 2 options' ); + +is( $stuff->remove_last_option, 12, '... removed the last option' ); +is( $stuff->remove_first_option, 10, '... removed the last option' ); + +is_deeply( $stuff->options, [], '... no options anymore' ); + +ok( $stuff->has_no_options, '... no options' ); +is( $stuff->num_options, 0, '... got no options' ); + +lives_ok { + $stuff->add_options( 1, 2, 3 ); +} +'... set the option okay'; + +is_deeply( $stuff->options, [ 1, 2, 3 ], '... got options now' ); + +ok( !$stuff->has_no_options, '... has options' ); +is( $stuff->num_options, 3, '... got 3 options' ); + +is( $stuff->get_option_at(0), 1, '... get option at index 0' ); +is( $stuff->get_option_at(1), 2, '... get option at index 1' ); +is( $stuff->get_option_at(2), 3, '... get option at index 2' ); + +lives_ok { + $stuff->set_option_at( 1, 100 ); +} +'... set the option okay'; + +is( $stuff->get_option_at(1), 100, '... get option at index 1' ); + +lives_ok { + $stuff->add_options( 10, 15 ); +} +'... set the option okay'; + +is_deeply( $stuff->options, [ 1, 100, 3, 10, 15 ], + '... got more options now' ); + +is( $stuff->num_options, 5, '... got 5 options' ); + +is( $stuff->remove_last_option, 15, '... removed the last option' ); + +is( $stuff->num_options, 4, '... got 4 options' ); +is_deeply( $stuff->options, [ 1, 100, 3, 10 ], '... got diff options now' ); + +lives_ok { + $stuff->insert_options( 10, 20 ); +} +'... set the option okay'; + +is( $stuff->num_options, 6, '... got 6 options' ); +is_deeply( $stuff->options, [ 10, 20, 1, 100, 3, 10 ], + '... got diff options now' ); + +is( $stuff->get_option_at(0), 10, '... get option at index 0' ); +is( $stuff->get_option_at(1), 20, '... get option at index 1' ); +is( $stuff->get_option_at(3), 100, '... get option at index 3' ); + +is( $stuff->remove_first_option, 10, '... getting the first option' ); + +is( $stuff->num_options, 5, '... got 5 options' ); +is( $stuff->get_option_at(0), 20, '... get option at index 0' ); + +$stuff->clear_options; +is_deeply( $stuff->options, [], "... clear options" ); + +$stuff->add_options( 5, 1, 2, 3 ); +$stuff->sort_options_in_place; +is_deeply( $stuff->options, [ 1, 2, 3, 5 ], + "... sort options in place (default sort order)" ); + +$stuff->sort_options_in_place( sub { $_[1] <=> $_[0] } ); +is_deeply( $stuff->options, [ 5, 3, 2, 1 ], + "... sort options in place (descending order)" ); + +$stuff->clear_options(); +$stuff->add_options( 5, 1, 2, 3 ); +lives_ok { + $stuff->descending_options(); +} +'... curried sort in place lives ok'; + +is_deeply( $stuff->options, [ 5, 3, 2, 1 ], "... sort currying" ); + +throws_ok { $stuff->sort_options_in_place('foo') } +qr/Argument must be a code reference/, + 'error when sort_in_place receives a non-coderef argument'; + +$stuff->clear_options; + +lives_ok { + $stuff->add_options('tree'); +} +'... set the options okay'; + +lives_ok { + $stuff->add_options_with_speed( 'compatible', 'safe' ); +} +'... add options with speed okay'; + +is_deeply( + $stuff->options, [qw/tree funrolls funbuns compatible safe/], + 'check options after add_options_with_speed' +); + +lives_ok { + $stuff->prepend_prerequisites_along_with(); +} +'... add prerequisite options okay'; + +$stuff->clear_options; +$stuff->add_options( 1, 2 ); + +lives_ok { + $stuff->splice_options( 1, 0, 'foo' ); +} +'... splice_options works'; + +is_deeply( + $stuff->options, [ 1, 'foo', 2 ], + 'splice added expected option' +); + +is( $stuff->option_accessor( 1 => 'foo++' ), 'foo++' ); +is( $stuff->option_accessor(1), 'foo++' ); + +## check some errors + +#dies_ok { +# $stuff->insert_options(undef); +#} '... could not add an undef where a string is expected'; +# +#dies_ok { +# $stuff->set_option(5, {}); +#} '... could not add a hash ref where a string is expected'; + +dies_ok { + Stuff->new( options => [ undef, 10, undef, 20 ] ); +} +'... bad constructor params'; + +dies_ok { + my $stuff = Stuff->new(); + $stuff->add_options(undef); +} +'... rejects push of an invalid type'; + +dies_ok { + my $stuff = Stuff->new(); + $stuff->insert_options(undef); +} +'... rejects unshift of an invalid type'; + +dies_ok { + my $stuff = Stuff->new(); + $stuff->set_option_at( 0, undef ); +} +'... rejects set of an invalid type'; + +dies_ok { + my $stuff = Stuff->new(); + $stuff->sort_in_place_options(undef); +} +'... sort rejects arg of invalid type'; + +dies_ok { + my $stuff = Stuff->new(); + $stuff->option_accessor(); +} +'... accessor rejects 0 args'; + +dies_ok { + my $stuff = Stuff->new(); + $stuff->option_accessor( 1, 2, 3 ); +} +'... accessor rejects 3 args'; + +## test the meta + +my $options = $stuff->meta->get_attribute('options'); +does_ok( $options, 'Mouse::Meta::Attribute::Native::Trait::Array' ); + +is_deeply( + $options->handles, + { + 'add_options' => 'push', + 'remove_last_option' => 'pop', + 'remove_first_option' => 'shift', + 'insert_options' => 'unshift', + 'get_option_at' => 'get', + 'set_option_at' => 'set', + 'num_options' => 'count', + 'has_no_options' => 'is_empty', + 'clear_options' => 'clear', + 'splice_options' => 'splice', + 'sort_options_in_place' => 'sort_in_place', + 'option_accessor' => 'accessor', + 'add_options_with_speed' => [ 'push' => 'funrolls', 'funbuns' ], + 'prepend_prerequisites_along_with' => + [ 'unshift' => 'first', 'second' ], + 'descending_options' => [ 'sort_in_place' => $sort ], + }, + '... got the right handles mapping' +); + +is( $options->type_constraint->type_parameter, 'Str', + '... got the right container type' ); + +done_testing; diff --git a/t/070_native_traits/203_trait_hash.t b/t/070_native_traits/203_trait_hash.t new file mode 100644 index 0000000..fb90ab3 --- /dev/null +++ b/t/070_native_traits/203_trait_hash.t @@ -0,0 +1,194 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; +$TODO = q{Mouse is not yet completed}; +use Test::Exception; +use Test::Mouse 'does_ok'; + +{ + package Stuff; + use Mouse; + + has 'options' => ( + traits => ['Hash'], + is => 'ro', + isa => 'HashRef[Str]', + default => sub { {} }, + handles => { + 'set_option' => 'set', + 'get_option' => 'get', + 'has_no_options' => 'is_empty', + 'num_options' => 'count', + 'clear_options' => 'clear', + 'delete_option' => 'delete', + 'has_option' => 'exists', + 'is_defined' => 'defined', + 'option_accessor' => 'accessor', + 'key_value' => 'kv', + 'options_elements' => 'elements', + 'quantity' => [ accessor => 'quantity' ], + }, + ); +} + +my $stuff = Stuff->new(); +isa_ok( $stuff, 'Stuff' ); + +can_ok( $stuff, $_ ) for qw[ + set_option + get_option + has_no_options + num_options + delete_option + clear_options + is_defined + has_option + quantity + option_accessor +]; + +ok( $stuff->has_no_options, '... we have no options' ); +is( $stuff->num_options, 0, '... we have no options' ); + +is_deeply( $stuff->options, {}, '... no options yet' ); +ok( !$stuff->has_option('foo'), '... we have no foo option' ); + +my $set_result; +lives_ok { + $set_result = $stuff->set_option( foo => 'bar' ); +} +'... set the option okay'; +is($set_result, 'bar', '... returns value set'); + +ok( $stuff->is_defined('foo'), '... foo is defined' ); + +ok( !$stuff->has_no_options, '... we have options' ); +is( $stuff->num_options, 1, '... we have 1 option(s)' ); +ok( $stuff->has_option('foo'), '... we have a foo option' ); +is_deeply( $stuff->options, { foo => 'bar' }, '... got options now' ); + +lives_ok { + $set_result = $stuff->set_option( bar => 'baz' ); +} +'... set the option okay'; +is($set_result, 'baz', '... returns value set'); + +is( $stuff->num_options, 2, '... we have 2 option(s)' ); +is_deeply( $stuff->options, { foo => 'bar', bar => 'baz' }, + '... got more options now' ); + +is( $stuff->get_option('foo'), 'bar', '... got the right option' ); + +is_deeply( [ $stuff->get_option(qw(foo bar)) ], [qw(bar baz)], + "get multiple options at once" ); + +is( scalar($stuff->get_option(qw( foo bar) )), "baz", + '... got last option in scalar context'); + +my @set_return; +lives_ok { + @set_return = $stuff->set_option( oink => "blah", xxy => "flop" ); +} +'... set the option okay'; +is_deeply(\@set_return, [ qw(blah flop) ], '... and returns values set'); + +is( $stuff->num_options, 4, "4 options" ); +is_deeply( [ $stuff->get_option(qw(foo bar oink xxy)) ], + [qw(bar baz blah flop)], "get multiple options at once" ); + +lives_ok { + $stuff->delete_option('bar'); +} +'... deleted the option okay'; + +lives_ok { + $stuff->delete_option('oink','xxy'); +} +'... deleted multiple option okay'; + +is( $stuff->num_options, 1, '... we have 1 option(s)' ); +is_deeply( $stuff->options, { foo => 'bar' }, '... got more options now' ); + +$stuff->clear_options; + +is_deeply( $stuff->options, {}, "... cleared options" ); + +lives_ok { + $stuff->quantity(4); +} +'... options added okay with defaults'; + +is( $stuff->quantity, 4, 'reader part of curried accessor works' ); + +is_deeply( $stuff->options, { quantity => 4 }, '... returns what we expect' ); + +lives_ok { + Stuff->new( options => { foo => 'BAR' } ); +} +'... good constructor params'; + +## check some errors + +dies_ok { + $stuff->set_option( bar => {} ); +} +'... could not add a hash ref where an string is expected'; + +dies_ok { + Stuff->new( options => { foo => [] } ); +} +'... bad constructor params'; + +## test the meta + +my $options = $stuff->meta->get_attribute('options'); +does_ok( $options, 'Mouse::Meta::Attribute::Native::Trait::Hash' ); + +is_deeply( + $options->handles, + { + 'set_option' => 'set', + 'get_option' => 'get', + 'has_no_options' => 'is_empty', + 'num_options' => 'count', + 'clear_options' => 'clear', + 'delete_option' => 'delete', + 'has_option' => 'exists', + 'is_defined' => 'defined', + 'option_accessor' => 'accessor', + 'key_value' => 'kv', + 'options_elements' => 'elements', + 'quantity' => [ accessor => 'quantity' ], + }, + '... got the right handles mapping' +); + +is( $options->type_constraint->type_parameter, 'Str', + '... got the right container type' ); + +$stuff->set_option( oink => "blah", xxy => "flop" ); +my @key_value = sort{ $a->[0] cmp $b->[0] } $stuff->key_value; +is_deeply( + \@key_value, + [ sort{ $a->[0] cmp $b->[0] } [ 'xxy', 'flop' ], [ 'quantity', 4 ], [ 'oink', 'blah' ] ], + '... got the right key value pairs' +) or do{ require Data::Dumper; diag(Data::Dumper::Dumper(\@key_value)) }; + +my %options_elements = $stuff->options_elements; +is_deeply( + \%options_elements, + { + 'oink' => 'blah', + 'quantity' => 4, + 'xxy' => 'flop' + }, + '... got the right hash elements' +); + +done_testing; diff --git a/t/070_native_traits/207_trait_string.t b/t/070_native_traits/207_trait_string.t new file mode 100644 index 0000000..9be0c2c --- /dev/null +++ b/t/070_native_traits/207_trait_string.t @@ -0,0 +1,121 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; +$TODO = q{Mouse is not yet completed}; +use Test::Mouse 'does_ok'; + +my $uc; +{ + package MyHomePage; + use Mouse; + + has 'string' => ( + traits => ['String'], + is => 'rw', + isa => 'Str', + default => sub {''}, + handles => { + inc_string => 'inc', + append_string => 'append', + prepend_string => 'prepend', + match_string => 'match', + replace_string => 'replace', + chop_string => 'chop', + chomp_string => 'chomp', + clear_string => 'clear', + length_string => 'length', + exclaim => [ append => '!' ], + capitalize_last => [ replace => qr/(.)$/, ($uc = sub { uc $1 }) ], + invalid_number => [ match => qr/\D/ ], + }, + ); +} + +my $page = MyHomePage->new(); +isa_ok( $page, 'MyHomePage' ); + +is( $page->string, '', '... got the default value' ); +is( $page->length_string, 0,'... length is zero' ); + +$page->string('a'); +is( $page->length_string, 1,'... new string has length of one' ); + +$page->inc_string; +is( $page->string, 'b', '... got the incremented value' ); + +$page->inc_string; +is( $page->string, 'c', '... got the incremented value (again)' ); + +$page->append_string("foo$/"); +is( $page->string, "cfoo$/", 'appended to string' ); + +$page->chomp_string; +is( $page->string, "cfoo", 'chomped string' ); + +$page->chomp_string; +is( $page->string, "cfoo", 'chomped is noop' ); + +$page->chop_string; +is( $page->string, "cfo", 'chopped string' ); + +$page->prepend_string("bar"); +is( $page->string, 'barcfo', 'prepended to string' ); + +is_deeply( [ $page->match_string(qr/([ao])/) ], ["a"], "match" ); + +$page->replace_string( qr/([ao])/, sub { uc($1) } ); +is( $page->string, 'bArcfo', "substitution" ); +is( $page->length_string, 6, 'right length' ); + +$page->exclaim; +is( $page->string, 'bArcfo!', 'exclaim!' ); + +$page->string('Moosex'); +$page->capitalize_last; +is( $page->string, 'MooseX', 'capitalize last' ); + +$page->string('1234'); +ok( !$page->invalid_number, 'string "isn\'t an invalid number' ); + +$page->string('one two three four'); +ok( $page->invalid_number, 'string an invalid number' ); + +$page->clear_string; +is( $page->string, '', "clear" ); + +# check the meta .. + +my $string = $page->meta->get_attribute('string'); +does_ok( $string, 'Mouse::Meta::Attribute::Native::Trait::String' ); + +is( + $string->type_constraint->name, 'Str', + '... got the expected type constraint' +); + +is_deeply( + $string->handles, + { + inc_string => 'inc', + append_string => 'append', + prepend_string => 'prepend', + match_string => 'match', + replace_string => 'replace', + chop_string => 'chop', + chomp_string => 'chomp', + clear_string => 'clear', + length_string => 'length', + exclaim => [ append => '!' ], + capitalize_last => [ replace => qr/(.)$/, $uc ], + invalid_number => [ match => qr/\D/ ], + }, + '... got the right handles methods' +); + +done_testing; diff --git a/t/070_native_traits/208_trait_bool.t b/t/070_native_traits/208_trait_bool.t new file mode 100644 index 0000000..4c677d6 --- /dev/null +++ b/t/070_native_traits/208_trait_bool.t @@ -0,0 +1,46 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; + +{ + package Room; + use Mouse; + + has 'is_lit' => ( + traits => ['Bool'], + is => 'rw', + isa => 'Bool', + default => 0, + handles => { + illuminate => 'set', + darken => 'unset', + flip_switch => 'toggle', + is_dark => 'not', + }, + ) +} + +my $room = Room->new; +$room->illuminate; +ok( $room->is_lit, 'set is_lit to 1 using ->illuminate' ); +ok( !$room->is_dark, 'check if is_dark does the right thing' ); + +$room->darken; +ok( !$room->is_lit, 'set is_lit to 0 using ->darken' ); +ok( $room->is_dark, 'check if is_dark does the right thing' ); + +$room->flip_switch; +ok( $room->is_lit, 'toggle is_lit back to 1 using ->flip_switch' ); +ok( !$room->is_dark, 'check if is_dark does the right thing' ); + +$room->flip_switch; +ok( !$room->is_lit, 'toggle is_lit back to 0 again using ->flip_switch' ); +ok( $room->is_dark, 'check if is_dark does the right thing' ); + +done_testing; diff --git a/t/070_native_traits/209_trait_code.t b/t/070_native_traits/209_trait_code.t new file mode 100644 index 0000000..5ed7ae8 --- /dev/null +++ b/t/070_native_traits/209_trait_code.t @@ -0,0 +1,51 @@ +use strict; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use warnings; + +use Test::More; + +{ + package Thingy; + use Mouse; + + has callback => ( + traits => ['Code'], + isa => 'CodeRef', + required => 1, + handles => { 'invoke_callback' => 'execute' }, + ); + + has callback_method => ( + traits => ['Code'], + isa => 'CodeRef', + required => 1, + handles => { 'invoke_method_callback' => 'execute_method' }, + ); + + has multiplier => ( + traits => ['Code'], + isa => 'CodeRef', + required => 1, + handles => { 'multiply' => 'execute' }, + ); +} + +my $i = 0; +my $thingy = Thingy->new( + callback => sub { ++$i }, + multiplier => sub { $_[0] * 2 }, + callback_method => sub { shift->multiply(@_) }, +); + +is($i, 0); +$thingy->invoke_callback; +is($i, 1); +is($thingy->multiply(3), 6); +is($thingy->invoke_method_callback(3), 6); + +ok(!$thingy->can($_), "Code trait didn't create reader method for $_") + for qw(callback callback_method multiplier); + +done_testing; diff --git a/t/070_native_traits/300_array_subtypes.t b/t/070_native_traits/300_array_subtypes.t new file mode 100644 index 0000000..37d7ab5 --- /dev/null +++ b/t/070_native_traits/300_array_subtypes.t @@ -0,0 +1,181 @@ +#!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use strict; +use warnings; +use Test::More; +use Test::Exception; + +{ + use Mouse::Util::TypeConstraints; + use List::Util qw(sum); + + subtype 'A1', as 'ArrayRef[Int]'; + subtype 'A2', as 'ArrayRef', where { @$_ < 2 }; + subtype 'A3', as 'ArrayRef[Int]', where { sum @$_ < 5 }; + + no Mouse::Util::TypeConstraints; +} + +{ + package Foo; + use Mouse; + + has array => ( + traits => ['Array'], + is => 'rw', + isa => 'ArrayRef', + handles => { + push_array => 'push', + }, + ); + has array_int => ( + traits => ['Array'], + is => 'rw', + isa => 'ArrayRef[Int]', + handles => { + push_array_int => 'push', + }, + ); + has a1 => ( + traits => ['Array'], + is => 'rw', + isa => 'A1', + handles => { + push_a1 => 'push', + }, + ); + has a2 => ( + traits => ['Array'], + is => 'rw', + isa => 'A2', + handles => { + push_a2 => 'push', + }, + ); + has a3 => ( + traits => ['Array'], + is => 'rw', + isa => 'A3', + handles => { + push_a3 => 'push', + }, + ); +} + +my $foo = Foo->new; + +{ + my $array = []; + dies_ok { $foo->push_array('foo') } "can't push onto undef"; + + $foo->array($array); + is($foo->array, $array, "same ref"); + is_deeply($foo->array, [], "correct contents"); + + $foo->push_array('foo'); + is($foo->array, $array, "same ref"); + is_deeply($foo->array, ['foo'], "correct contents"); +} + +{ + my $array = []; + dies_ok { $foo->push_array_int(1) } "can't push onto undef"; + + $foo->array_int($array); + is($foo->array_int, $array, "same ref"); + is_deeply($foo->array_int, [], "correct contents"); + + dies_ok { $foo->push_array_int('foo') } "can't push wrong type"; + is($foo->array_int, $array, "same ref"); + is_deeply($foo->array_int, [], "correct contents"); + @$array = (); + + $foo->push_array_int(1); + is($foo->array_int, $array, "same ref"); + is_deeply($foo->array_int, [1], "correct contents"); +} + +{ + my $array = []; + dies_ok { $foo->push_a1('foo') } "can't push onto undef"; + + $foo->a1($array); + is($foo->a1, $array, "same ref"); + is_deeply($foo->a1, [], "correct contents"); + + { local $TODO = "type parameters aren't checked on subtypes"; + dies_ok { $foo->push_a1('foo') } "can't push wrong type"; + } + is($foo->a1, $array, "same ref"); + { local $TODO = "type parameters aren't checked on subtypes"; + is_deeply($foo->a1, [], "correct contents"); + } + @$array = (); + + $foo->push_a1(1); + is($foo->a1, $array, "same ref"); + is_deeply($foo->a1, [1], "correct contents"); +} + +{ + my $array = []; + dies_ok { $foo->push_a2('foo') } "can't push onto undef"; + + $foo->a2($array); + is($foo->a2, $array, "same ref"); + is_deeply($foo->a2, [], "correct contents"); + + $foo->push_a2('foo'); + is($foo->a2, $array, "same ref"); + is_deeply($foo->a2, ['foo'], "correct contents"); + + { local $TODO = "overall tcs aren't checked"; + dies_ok { $foo->push_a2('bar') } "can't push more than one element"; + } + is($foo->a2, $array, "same ref"); + { local $TODO = "overall tcs aren't checked"; + is_deeply($foo->a2, ['foo'], "correct contents"); + } +} + +{ + my $array = []; + dies_ok { $foo->push_a3(1) } "can't push onto undef"; + + $foo->a3($array); + is($foo->a3, $array, "same ref"); + is_deeply($foo->a3, [], "correct contents"); + + { local $TODO = "tc parameters aren't checked on subtypes"; + dies_ok { $foo->push_a3('foo') } "can't push non-int"; + } + { local $TODO = "overall tcs aren't checked"; + dies_ok { $foo->push_a3(100) } "can't violate overall type constraint"; + } + is($foo->a3, $array, "same ref"); + { local $TODO = "tc checks are broken"; + is_deeply($foo->a3, [], "correct contents"); + } + @$array = (); + + $foo->push_a3(1); + is($foo->a3, $array, "same ref"); + is_deeply($foo->a3, [1], "correct contents"); + + { local $TODO = "overall tcs aren't checked"; + dies_ok { $foo->push_a3(100) } "can't violate overall type constraint"; + } + is($foo->a3, $array, "same ref"); + { local $TODO = "overall tcs aren't checked"; + is_deeply($foo->a3, [1], "correct contents"); + } + @$array = (1); + + $foo->push_a3(3); + is($foo->a3, $array, "same ref"); + is_deeply($foo->a3, [1, 3], "correct contents"); +} + +done_testing; diff --git a/t/100_bugs/001_subtype_quote_bug.t b/t/100_bugs/001_subtype_quote_bug.t index 406cafa..a6827ab 100644 --- a/t/100_bugs/001_subtype_quote_bug.t +++ b/t/100_bugs/001_subtype_quote_bug.t @@ -1,9 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 1; +use Test::More; =pod @@ -28,5 +31,9 @@ be well from now on. { package Object::Test; } -package Foo; -::use_ok('Mouse'); +{ + package Foo; + ::use_ok('Mouse'); +} + +done_testing; diff --git a/t/100_bugs/002_subtype_conflict_bug.t b/t/100_bugs/002_subtype_conflict_bug.t index 7ae2de3..00203a3 100644 --- a/t/100_bugs/002_subtype_conflict_bug.t +++ b/t/100_bugs/002_subtype_conflict_bug.t @@ -1,13 +1,16 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; use lib 't/lib', 'lib'; -use Test::More tests => 2; +use Test::More; +use_ok('MyMooseA'); +use_ok('MyMooseB'); - -use_ok('MyMouseA'); -use_ok('MyMouseB'); \ No newline at end of file +done_testing; diff --git a/t/100_bugs/003_Moose_Object_error.t b/t/100_bugs/003_Moose_Object_error.t index 6dedb64..b142692 100644 --- a/t/100_bugs/003_Moose_Object_error.t +++ b/t/100_bugs/003_Moose_Object_error.t @@ -1,10 +1,15 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; use lib 't/lib', 'lib'; -use Test::More tests => 1; +use Test::More; -use_ok('MyMouseObject'); \ No newline at end of file +use_ok('MyMooseObject'); + +done_testing; diff --git a/t/100_bugs/004_subclass_use_base_bug.t b/t/100_bugs/004_subclass_use_base_bug.t index 3ced9a4..43986f1 100644 --- a/t/100_bugs/004_subclass_use_base_bug.t +++ b/t/100_bugs/004_subclass_use_base_bug.t @@ -1,11 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 2; - - +use Test::More; =pod @@ -28,3 +29,5 @@ a metaclass initialized for it correctly. my $bar = Bar->new; isa_ok($bar, 'Bar'); isa_ok($bar, 'Foo'); + +done_testing; diff --git a/t/100_bugs/005_inline_reader_bug.t b/t/100_bugs/005_inline_reader_bug.t index 021c3ad..e5a34d7 100644 --- a/t/100_bugs/005_inline_reader_bug.t +++ b/t/100_bugs/005_inline_reader_bug.t @@ -1,13 +1,15 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 1; +use Test::More; use Test::Exception; - =pod This was a bug, but it is fixed now. This @@ -29,3 +31,4 @@ test makes sure it does not creep back in. } '... this didnt die'; } +done_testing; diff --git a/t/100_bugs/007_reader_precedence_bug.t b/t/100_bugs/007_reader_precedence_bug.t index 0f6d608..d64c208 100644 --- a/t/100_bugs/007_reader_precedence_bug.t +++ b/t/100_bugs/007_reader_precedence_bug.t @@ -1,9 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 3; +use Test::More; { package Foo; @@ -20,6 +23,4 @@ use Test::More tests => 3; is($foo->$reader, 10, "Reader works as expected"); } - - - +done_testing; diff --git a/t/100_bugs/009_augment_recursion_bug.t b/t/100_bugs/009_augment_recursion_bug.t index cd401d9..0633b8e 100644 --- a/t/100_bugs/009_augment_recursion_bug.t +++ b/t/100_bugs/009_augment_recursion_bug.t @@ -1,10 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 3; - +use Test::More; { @@ -47,3 +49,4 @@ is($baz->foo, 'Foo::foo(Baz::foo and Foo::foo())', '... got the right value for 1 augmented subclass calling non-augmented subclass'); +done_testing; diff --git a/t/100_bugs/010_immutable_n_default_x2.t b/t/100_bugs/010_immutable_n_default_x2.t index 72f6493..fb9bd35 100644 --- a/t/100_bugs/010_immutable_n_default_x2.t +++ b/t/100_bugs/010_immutable_n_default_x2.t @@ -1,10 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 2; - +use Test::More; { @@ -38,3 +40,5 @@ is($Foo::foo_default_called, 1, "foo default was only called once during constru $foo->bar(); is($Foo::bar_default_called, 1, "bar default was only called once when lazy attribute is accessed"); + +done_testing; diff --git a/t/100_bugs/011_DEMOLISH_eats_exceptions.t b/t/100_bugs/011_DEMOLISH_eats_exceptions.t index c83a2ce..3c6aefe 100644 --- a/t/100_bugs/011_DEMOLISH_eats_exceptions.t +++ b/t/100_bugs/011_DEMOLISH_eats_exceptions.t @@ -1,10 +1,13 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; use FindBin; -use Test::More tests => 144; +use Test::More; use Test::Exception; use Mouse::Util::TypeConstraints; @@ -149,5 +152,4 @@ sub check_em { } } -1; - +done_testing; diff --git a/t/100_bugs/012_DEMOLISH_eats_mini.t b/t/100_bugs/012_DEMOLISH_eats_mini.t index 976275e..c8465a6 100644 --- a/t/100_bugs/012_DEMOLISH_eats_mini.t +++ b/t/100_bugs/012_DEMOLISH_eats_mini.t @@ -1,4 +1,7 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; @@ -78,30 +81,4 @@ use Test::Exception; if Baz->meta->is_mutable } -# The following tests will fail on 5.13.0, so skipt them :( -if($] >= 5.013) { - done_testing; - exit; -} - -{ - package Quux; - use Mouse; - - sub DEMOLISH { - die "foo\n"; - } -} - -{ - local $@ = 42; - - eval { my $obj = Quux->new }; - - like( $@, qr/foo/, '$@ contains error from demolish when demolish dies' ); - - Quux->meta->make_immutable, redo - if Quux->meta->is_mutable -} - done_testing; diff --git a/t/100_bugs/013_lazybuild_required_undef.t b/t/100_bugs/013_lazybuild_required_undef.t index a5377cb..d4cba48 100644 --- a/t/100_bugs/013_lazybuild_required_undef.t +++ b/t/100_bugs/013_lazybuild_required_undef.t @@ -1,7 +1,7 @@ -use strict; -use Test::More tests => 4; - package Foo; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use Mouse; ## Problem: @@ -14,12 +14,13 @@ use Mouse; #### or, make required accept undef and use a predicate test -has 'foo' => ( isa => 'Int | Undef', is => 'rw', coerce => 1, lazy_build => 1 ); -has 'bar' => ( isa => 'Int | Undef', is => 'rw', coerce => 1 ); +has 'foo' => ( isa => 'Int | Undef', is => 'rw', lazy_build => 1 ); +has 'bar' => ( isa => 'Int | Undef', is => 'rw' ); sub _build_foo { undef } package main; +use Test::More; ok ( !defined(Foo->new->bar), 'NonLazyBuild: Undef default' ); ok ( !defined(Foo->new->bar(undef)), 'NonLazyBuild: Undef explicit' ); @@ -28,3 +29,5 @@ ok ( !defined(Foo->new->foo), 'LazyBuild: Undef default/lazy_build' ); ## This test fails at the time of creation. ok ( !defined(Foo->new->foo(undef)), 'LazyBuild: Undef explicit' ); + +done_testing; diff --git a/t/100_bugs/014_DEMOLISHALL.t b/t/100_bugs/014_DEMOLISHALL.t new file mode 100644 index 0000000..ff100ff --- /dev/null +++ b/t/100_bugs/014_DEMOLISHALL.t @@ -0,0 +1,59 @@ +#!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use strict; +use warnings; +use Test::More; +$TODO = q{Mouse is not yet completed}; + +my @called; + +do { + package Class; + use Mouse; + + sub DEMOLISH { + push @called, 'Class::DEMOLISH'; + } + + sub DEMOLISHALL { + my $self = shift; + push @called, 'Class::DEMOLISHALL'; + $self->SUPER::DEMOLISHALL(@_); + } + + package Child; + use Mouse; + extends 'Class'; + + sub DEMOLISH { + push @called, 'Child::DEMOLISH'; + } + + sub DEMOLISHALL { + my $self = shift; + push @called, 'Child::DEMOLISHALL'; + $self->SUPER::DEMOLISHALL(@_); + } +}; + +is_deeply([splice @called], [], "no DEMOLISH calls yet"); + +do { + my $object = Class->new; + + is_deeply([splice @called], [], "no DEMOLISH calls yet"); +}; + +is_deeply([splice @called], ['Class::DEMOLISHALL', 'Class::DEMOLISH']); + +do { + my $child = Child->new; + is_deeply([splice @called], [], "no DEMOLISH calls yet"); + +}; + +is_deeply([splice @called], ['Child::DEMOLISHALL', 'Class::DEMOLISHALL', 'Child::DEMOLISH', 'Class::DEMOLISH']); + +done_testing; diff --git a/t/100_bugs/016_inheriting_from_roles.t b/t/100_bugs/016_inheriting_from_roles.t index 269efcb..cbfde1b 100644 --- a/t/100_bugs/016_inheriting_from_roles.t +++ b/t/100_bugs/016_inheriting_from_roles.t @@ -1,13 +1,15 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 1; +use Test::More; use Test::Exception; - { package My::Role; use Mouse::Role; @@ -21,3 +23,5 @@ use Test::Exception; } qr/You cannot inherit from a Mouse Role \(My\:\:Role\)/, '... this croaks correctly'; } + +done_testing; diff --git a/t/100_bugs/017_type_constraint_messages.t b/t/100_bugs/017_type_constraint_messages.t index 4965eda..1f5776b 100644 --- a/t/100_bugs/017_type_constraint_messages.t +++ b/t/100_bugs/017_type_constraint_messages.t @@ -1,13 +1,15 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 3; +use Test::More; use Test::Exception; - # RT #37569 { @@ -71,3 +73,4 @@ throws_ok { qr/Attribute \(nt\) does not pass the type constraint because: blessed/, '... got the right error message'; +done_testing; diff --git a/t/100_bugs/019_moose_octal_defaults.t b/t/100_bugs/019_moose_octal_defaults.t index 1766946..01293fb 100644 --- a/t/100_bugs/019_moose_octal_defaults.t +++ b/t/100_bugs/019_moose_octal_defaults.t @@ -1,5 +1,8 @@ #!/usr/bin/env perl -use Test::More tests => 10; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use Test::More; { my $package = qq{ @@ -115,3 +118,5 @@ __PACKAGE__->meta->make_immutable; my $obj = Test::Mouse::Go::Boom5->new; ::is( $obj->id, '0 but true', 'value is still the same' ); } + +done_testing; diff --git a/t/100_bugs/020_super_recursion.t b/t/100_bugs/020_super_recursion.t index ff691f9..9b5f7d3 100644 --- a/t/100_bugs/020_super_recursion.t +++ b/t/100_bugs/020_super_recursion.t @@ -1,7 +1,10 @@ use strict; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use warnings; -use Test::More tests => 3; +use Test::More; { package A; @@ -65,3 +68,5 @@ use Test::More tests => 3; is( C->new->foo, 'c' ); is( C->new->bar, 'cb' ); is( C->new->baz, 'cba' ); + +done_testing; diff --git a/t/100_bugs/021_DEMOLISHALL_shortcutted.t b/t/100_bugs/021_DEMOLISHALL_shortcutted.t new file mode 100644 index 0000000..577a3db --- /dev/null +++ b/t/100_bugs/021_DEMOLISHALL_shortcutted.t @@ -0,0 +1,36 @@ +## This test ensures that sub DEMOLISHALL fires even if there is no sub DEMOLISH +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +## Currently fails because of a bad optimization in DESTROY +## Feb 12, 2009 -- Evan Carroll me@evancarroll.com +package Role::DemolishAll; +use Mouse::Role; +our $ok = 0; + +sub BUILD { $ok = 0 }; +after 'DEMOLISHALL' => sub { $Role::DemolishAll::ok++ }; + +package DemolishAll::WithoutDemolish; +use Mouse; +with 'Role::DemolishAll'; + +package DemolishAll::WithDemolish; +use Mouse; +with 'Role::DemolishAll'; +sub DEMOLISH {}; + + +package main; +use Test::More; +$TODO = q{Mouse is not yet completed}; + +my $m = DemolishAll::WithDemolish->new; +undef $m; +is ( $Role::DemolishAll::ok, 1, 'DemolishAll w/ explicit DEMOLISH sub' ); + +$m = DemolishAll::WithoutDemolish->new; +undef $m; +is ( $Role::DemolishAll::ok, 1, 'DemolishAll wo/ explicit DEMOLISH sub' ); + +done_testing; diff --git a/t/100_bugs/022_role_caller.t b/t/100_bugs/022_role_caller.t index 7c339f6..fc2cd94 100644 --- a/t/100_bugs/022_role_caller.t +++ b/t/100_bugs/022_role_caller.t @@ -1,6 +1,7 @@ -use Test::More tests => 4; - package MyRole; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use Mouse::Role; @@ -13,6 +14,8 @@ package MyClass2; use Mouse; with 'MyRole'; no Mouse; package main; +use Test::More; + { local $TODO = 'Role composition does not clone methods yet'; is(MyClass1->foo, 'MyClass1::foo', @@ -23,3 +26,5 @@ package main; isnt(MyClass1->foo, "MyClass2::foo", "role method is not confused with other class" ); isnt(MyClass2->foo, "MyClass1::foo", "role method is not confused with other class" ); + +done_testing; diff --git a/t/100_bugs/025_universal_methods_wrappable.t b/t/100_bugs/025_universal_methods_wrappable.t index c995172..a7507db 100644 --- a/t/100_bugs/025_universal_methods_wrappable.t +++ b/t/100_bugs/025_universal_methods_wrappable.t @@ -1,8 +1,11 @@ use strict; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use warnings; use Test::Exception; -use Test::More tests => 2; +use Test::More; { @@ -27,3 +30,5 @@ use Test::More tests => 2; my $foo = Foo->new; ::isa_ok $foo, 'Bar'; } + +done_testing; diff --git a/t/100_bugs/026_create_anon_recursion.t b/t/100_bugs/026_create_anon_recursion.t index c1f9159..c5f4562 100644 --- a/t/100_bugs/026_create_anon_recursion.t +++ b/t/100_bugs/026_create_anon_recursion.t @@ -1,7 +1,10 @@ use strict; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use warnings; -use Test::More tests => 1; +use Test::More; use Test::Exception; use Mouse::Meta::Class; @@ -10,8 +13,8 @@ $SIG{__WARN__} = sub { die if shift =~ /recurs/ }; TODO: { -# local $TODO -# = 'Loading Mouse::Meta::Class without loading Mouse.pm causes weird problems'; + local $TODO + = 'Loading Mouse::Meta::Class without loading Mouse.pm causes weird problems'; my $meta; lives_ok { @@ -21,3 +24,5 @@ TODO: } 'Class is created successfully'; } + +done_testing; diff --git a/t/100_bugs/027_constructor_object_overload.t b/t/100_bugs/027_constructor_object_overload.t index 0dfba1c..7a9a6e7 100644 --- a/t/100_bugs/027_constructor_object_overload.t +++ b/t/100_bugs/027_constructor_object_overload.t @@ -1,7 +1,10 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 1; +use Test::More; { package Foo; @@ -17,3 +20,4 @@ use Test::More tests => 1; ok(Foo->new()->bug(), 'call constructor on object reference with overloading'); +done_testing; diff --git a/t/100_bugs/028_apply_role_to_one_instance_only.t b/t/100_bugs/028_apply_role_to_one_instance_only.t new file mode 100644 index 0000000..a22afdb --- /dev/null +++ b/t/100_bugs/028_apply_role_to_one_instance_only.t @@ -0,0 +1,48 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use strict; +use warnings; +use Test::More; +$TODO = q{Mouse is not yet completed}; +use Test::Exception; + +{ + package MyRole1; + use Mouse::Role; + + sub a_role_method { 'foo' } +} + +{ + package MyRole2; + use Mouse::Role; + # empty +} + +{ + package Foo; + use Mouse; +} + +my $instance_with_role1 = Foo->new; +MyRole1->meta->apply($instance_with_role1); + +my $instance_with_role2 = Foo->new; +MyRole2->meta->apply($instance_with_role2); + +ok ((not $instance_with_role2->does('MyRole1')), + 'instance does not have the wrong role'); + +ok ((not $instance_with_role2->can('a_role_method')), + 'instance does not have methods from the wrong role'); + +ok (($instance_with_role1->does('MyRole1')), + 'role was applied to the correct instance'); + +lives_and { + is $instance_with_role1->a_role_method, 'foo' +} 'instance has correct role method'; + +done_testing; diff --git a/t/100_bugs/029_instance_application_role_args.t b/t/100_bugs/029_instance_application_role_args.t new file mode 100644 index 0000000..c1f431b --- /dev/null +++ b/t/100_bugs/029_instance_application_role_args.t @@ -0,0 +1,55 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use strict; +use warnings; +use Test::More; +use Test::Exception; + +{ + package Point; + use Mouse; + + with qw/DoesNegated DoesTranspose/; + + has x => ( isa => 'Int', is => 'rw' ); + has y => ( isa => 'Int', is => 'rw' ); + + sub inspect { [$_[0]->x, $_[0]->y] } + + no Mouse; +} + +{ + package DoesNegated; + use Mouse::Role; + + sub negated { + my $self = shift; + $self->new( x => -$self->x, y => -$self->y ); + } + + no Mouse::Role; +} + +{ + package DoesTranspose; + use Mouse::Role; + + sub transpose { + my $self = shift; + $self->new( x => $self->y, y => $self->x ); + } + + no Mouse::Role; +} + +my $p = Point->new( x => 4, y => 3 ); + +DoesTranspose->meta->apply( $p, -alias => { transpose => 'negated' } ); + +is_deeply($p->negated->inspect, [3, 4]); +is_deeply($p->transpose->inspect, [3, 4]); + +done_testing; diff --git a/t/100_bugs/030_coerce_without_coercion.t b/t/100_bugs/030_coerce_without_coercion.t new file mode 100644 index 0000000..eec4424 --- /dev/null +++ b/t/100_bugs/030_coerce_without_coercion.t @@ -0,0 +1,41 @@ +use strict; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use warnings; + +use Test::More; +use Test::Exception; +use Test::Mouse; + +{ + package Foo; + + use Mouse::Deprecated -api_version => '1.07'; + use Mouse; + + has x => ( + is => 'rw', + isa => 'HashRef', + coerce => 1, + ); +} + +with_immutable { + lives_ok { Foo->new( x => {} ) } + 'Setting coerce => 1 without a coercion on the type does not cause an error in the constructor'; + + lives_ok { Foo->new->x( {} ) } + 'Setting coerce => 1 without a coercion on the type does not cause an error when setting the attribut'; + + throws_ok { Foo->new( x => 42 ) } + qr/\QAttribute (x) does not pass the type constraint because/, + 'Attempting to provide an invalid value to the constructor for this attr still fails'; + + throws_ok { Foo->new->x(42) } + qr/\QAttribute (x) does not pass the type constraint because/, + 'Attempting to provide an invalid value to the accessor for this attr still fails'; +} +'Foo'; + +done_testing; diff --git a/t/200_examples/001_example.t b/t/200_examples/001_example.t index 515fc1a..e6a4a2d 100644 --- a/t/200_examples/001_example.t +++ b/t/200_examples/001_example.t @@ -1,11 +1,15 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 20; +use Test::More; use Test::Exception; + ## Roles { @@ -124,3 +128,4 @@ ok($at_least_10_chars->does('Constraint::OnLength'), '... Constraint::LengthAtLe ok(!defined($at_least_10_chars->validate('barrrrrrrrr')), '... validated correctly'); is($at_least_10_chars->validate('bar'), 'must be at least 10 chars', '... validation failed correctly'); +done_testing; diff --git a/t/200_examples/002_example_Moose_POOP.t b/t/200_examples/002_example_Moose_POOP.t new file mode 100644 index 0000000..4db02f7 --- /dev/null +++ b/t/200_examples/002_example_Moose_POOP.t @@ -0,0 +1,440 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; + +use Test::Requires { + 'DBM::Deep' => '1.0003', # skip all if not installed + 'DateTime::Format::MySQL' => '0.01', +}; + +use Test::Exception; + +BEGIN { + # in case there are leftovers + unlink('newswriter.db') if -e 'newswriter.db'; +} + +END { + unlink('newswriter.db') if -e 'newswriter.db'; +} + + +=pod + +This example creates a very basic Object Database which +links in the instances created with a backend store +(a DBM::Deep hash). It is by no means to be taken seriously +as a real-world ODB, but is a proof of concept of the flexibility +of the ::Instance protocol. + +=cut + +BEGIN { + + package Mouse::POOP::Meta::Instance; + use Mouse; + + use DBM::Deep; + + extends 'Mouse::Meta::Instance'; + + { + my %INSTANCE_COUNTERS; + + my $db = DBM::Deep->new({ + file => "newswriter.db", + autobless => 1, + locking => 1, + }); + + sub _reload_db { + #use Data::Dumper; + #warn Dumper $db; + $db = undef; + $db = DBM::Deep->new({ + file => "newswriter.db", + autobless => 1, + locking => 1, + }); + } + + sub create_instance { + my $self = shift; + my $class = $self->associated_metaclass->name; + my $oid = ++$INSTANCE_COUNTERS{$class}; + + $db->{$class}->[($oid - 1)] = {}; + + bless { + oid => $oid, + instance => $db->{$class}->[($oid - 1)] + }, $class; + } + + sub find_instance { + my ($self, $oid) = @_; + my $instance = $db->{$self->associated_metaclass->name}->[($oid - 1)]; + + bless { + oid => $oid, + instance => $instance, + }, $self->associated_metaclass->name; + } + + sub clone_instance { + my ($self, $instance) = @_; + + my $class = $self->{meta}->name; + my $oid = ++$INSTANCE_COUNTERS{$class}; + + my $clone = tied($instance)->clone; + + bless { + oid => $oid, + instance => $clone, + }, $class; + } + } + + sub get_instance_oid { + my ($self, $instance) = @_; + $instance->{oid}; + } + + sub get_slot_value { + my ($self, $instance, $slot_name) = @_; + return $instance->{instance}->{$slot_name}; + } + + sub set_slot_value { + my ($self, $instance, $slot_name, $value) = @_; + $instance->{instance}->{$slot_name} = $value; + } + + sub is_slot_initialized { + my ($self, $instance, $slot_name, $value) = @_; + exists $instance->{instance}->{$slot_name} ? 1 : 0; + } + + sub weaken_slot_value { + confess "Not sure how well DBM::Deep plays with weak refs, Rob says 'Write a test'"; + } + + sub inline_slot_access { + my ($self, $instance, $slot_name) = @_; + sprintf "%s->{instance}->{%s}", $instance, $slot_name; + } + + package Mouse::POOP::Meta::Class; + use Mouse; + + extends 'Mouse::Meta::Class'; + + override '_construct_instance' => sub { + my $class = shift; + my $params = @_ == 1 ? $_[0] : {@_}; + return $class->get_meta_instance->find_instance($params->{oid}) + if $params->{oid}; + super(); + }; + +} +{ + package Mouse::POOP::Object; + use metaclass 'Mouse::POOP::Meta::Class' => ( + instance_metaclass => 'Mouse::POOP::Meta::Instance' + ); + use Mouse; + + sub oid { + my $self = shift; + $self->meta + ->get_meta_instance + ->get_instance_oid($self); + } + +} +{ + package Newswriter::Author; + use Mouse; + + extends 'Mouse::POOP::Object'; + + has 'first_name' => (is => 'rw', isa => 'Str'); + has 'last_name' => (is => 'rw', isa => 'Str'); + + package Newswriter::Article; + use Mouse; + use Mouse::Util::TypeConstraints; + + use DateTime::Format::MySQL; + + extends 'Mouse::POOP::Object'; + + subtype 'Headline' + => as 'Str' + => where { length($_) < 100 }; + + subtype 'Summary' + => as 'Str' + => where { length($_) < 255 }; + + subtype 'DateTimeFormatString' + => as 'Str' + => where { DateTime::Format::MySQL->parse_datetime($_) }; + + enum 'Status' => qw(draft posted pending archive); + + has 'headline' => (is => 'rw', isa => 'Headline'); + has 'summary' => (is => 'rw', isa => 'Summary'); + has 'article' => (is => 'rw', isa => 'Str'); + + has 'start_date' => (is => 'rw', isa => 'DateTimeFormatString'); + has 'end_date' => (is => 'rw', isa => 'DateTimeFormatString'); + + has 'author' => (is => 'rw', isa => 'Newswriter::Author'); + + has 'status' => (is => 'rw', isa => 'Status'); + + around 'start_date', 'end_date' => sub { + my $c = shift; + my $self = shift; + $c->($self, DateTime::Format::MySQL->format_datetime($_[0])) if @_; + DateTime::Format::MySQL->parse_datetime($c->($self) || return undef); + }; +} + +{ # check the meta stuff first + isa_ok(Mouse::POOP::Object->meta, 'Mouse::POOP::Meta::Class'); + isa_ok(Mouse::POOP::Object->meta, 'Mouse::Meta::Class'); + isa_ok(Mouse::POOP::Object->meta, 'Mouse::Meta::Class'); + + is(Mouse::POOP::Object->meta->instance_metaclass, + 'Mouse::POOP::Meta::Instance', + '... got the right instance metaclass name'); + + isa_ok(Mouse::POOP::Object->meta->get_meta_instance, 'Mouse::POOP::Meta::Instance'); + + my $base = Mouse::POOP::Object->new; + isa_ok($base, 'Mouse::POOP::Object'); + isa_ok($base, 'Mouse::Object'); + + isa_ok($base->meta, 'Mouse::POOP::Meta::Class'); + isa_ok($base->meta, 'Mouse::Meta::Class'); + isa_ok($base->meta, 'Mouse::Meta::Class'); + + is($base->meta->instance_metaclass, + 'Mouse::POOP::Meta::Instance', + '... got the right instance metaclass name'); + + isa_ok($base->meta->get_meta_instance, 'Mouse::POOP::Meta::Instance'); +} + +my $article_oid; +my $article_ref; +{ + my $article; + lives_ok { + $article = Newswriter::Article->new( + headline => 'Home Office Redecorated', + summary => 'The home office was recently redecorated to match the new company colors', + article => '...', + + author => Newswriter::Author->new( + first_name => 'Truman', + last_name => 'Capote' + ), + + status => 'pending' + ); + } '... created my article successfully'; + isa_ok($article, 'Newswriter::Article'); + isa_ok($article, 'Mouse::POOP::Object'); + + lives_ok { + $article->start_date(DateTime->new(year => 2006, month => 6, day => 10)); + $article->end_date(DateTime->new(year => 2006, month => 6, day => 17)); + } '... add the article date-time stuff'; + + ## check some meta stuff + + isa_ok($article->meta, 'Mouse::POOP::Meta::Class'); + isa_ok($article->meta, 'Mouse::Meta::Class'); + isa_ok($article->meta, 'Mouse::Meta::Class'); + + is($article->meta->instance_metaclass, + 'Mouse::POOP::Meta::Instance', + '... got the right instance metaclass name'); + + isa_ok($article->meta->get_meta_instance, 'Mouse::POOP::Meta::Instance'); + + ok($article->oid, '... got a oid for the article'); + + $article_oid = $article->oid; + $article_ref = "$article"; + + is($article->headline, + 'Home Office Redecorated', + '... got the right headline'); + is($article->summary, + 'The home office was recently redecorated to match the new company colors', + '... got the right summary'); + is($article->article, '...', '... got the right article'); + + isa_ok($article->start_date, 'DateTime'); + isa_ok($article->end_date, 'DateTime'); + + isa_ok($article->author, 'Newswriter::Author'); + is($article->author->first_name, 'Truman', '... got the right author first name'); + is($article->author->last_name, 'Capote', '... got the right author last name'); + + is($article->status, 'pending', '... got the right status'); +} + +Mouse::POOP::Meta::Instance->_reload_db(); + +my $article2_oid; +my $article2_ref; +{ + my $article2; + lives_ok { + $article2 = Newswriter::Article->new( + headline => 'Company wins Lottery', + summary => 'An email was received today that informed the company we have won the lottery', + article => 'WoW', + + author => Newswriter::Author->new( + first_name => 'Katie', + last_name => 'Couric' + ), + + status => 'posted' + ); + } '... created my article successfully'; + isa_ok($article2, 'Newswriter::Article'); + isa_ok($article2, 'Mouse::POOP::Object'); + + $article2_oid = $article2->oid; + $article2_ref = "$article2"; + + is($article2->headline, + 'Company wins Lottery', + '... got the right headline'); + is($article2->summary, + 'An email was received today that informed the company we have won the lottery', + '... got the right summary'); + is($article2->article, 'WoW', '... got the right article'); + + ok(!$article2->start_date, '... these two dates are unassigned'); + ok(!$article2->end_date, '... these two dates are unassigned'); + + isa_ok($article2->author, 'Newswriter::Author'); + is($article2->author->first_name, 'Katie', '... got the right author first name'); + is($article2->author->last_name, 'Couric', '... got the right author last name'); + + is($article2->status, 'posted', '... got the right status'); + + ## orig-article + + my $article; + lives_ok { + $article = Newswriter::Article->new(oid => $article_oid); + } '... (re)-created my article successfully'; + isa_ok($article, 'Newswriter::Article'); + isa_ok($article, 'Mouse::POOP::Object'); + + is($article->oid, $article_oid, '... got a oid for the article'); + isnt($article_ref, "$article", '... got a new article instance'); + + is($article->headline, + 'Home Office Redecorated', + '... got the right headline'); + is($article->summary, + 'The home office was recently redecorated to match the new company colors', + '... got the right summary'); + is($article->article, '...', '... got the right article'); + + isa_ok($article->start_date, 'DateTime'); + isa_ok($article->end_date, 'DateTime'); + + isa_ok($article->author, 'Newswriter::Author'); + is($article->author->first_name, 'Truman', '... got the right author first name'); + is($article->author->last_name, 'Capote', '... got the right author last name'); + + lives_ok { + $article->author->first_name('Dan'); + $article->author->last_name('Rather'); + } '... changed the value ok'; + + is($article->author->first_name, 'Dan', '... got the changed author first name'); + is($article->author->last_name, 'Rather', '... got the changed author last name'); + + is($article->status, 'pending', '... got the right status'); +} + +Mouse::POOP::Meta::Instance->_reload_db(); + +{ + my $article; + lives_ok { + $article = Newswriter::Article->new(oid => $article_oid); + } '... (re)-created my article successfully'; + isa_ok($article, 'Newswriter::Article'); + isa_ok($article, 'Mouse::POOP::Object'); + + is($article->oid, $article_oid, '... got a oid for the article'); + isnt($article_ref, "$article", '... got a new article instance'); + + is($article->headline, + 'Home Office Redecorated', + '... got the right headline'); + is($article->summary, + 'The home office was recently redecorated to match the new company colors', + '... got the right summary'); + is($article->article, '...', '... got the right article'); + + isa_ok($article->start_date, 'DateTime'); + isa_ok($article->end_date, 'DateTime'); + + isa_ok($article->author, 'Newswriter::Author'); + is($article->author->first_name, 'Dan', '... got the changed author first name'); + is($article->author->last_name, 'Rather', '... got the changed author last name'); + + is($article->status, 'pending', '... got the right status'); + + my $article2; + lives_ok { + $article2 = Newswriter::Article->new(oid => $article2_oid); + } '... (re)-created my article successfully'; + isa_ok($article2, 'Newswriter::Article'); + isa_ok($article2, 'Mouse::POOP::Object'); + + is($article2->oid, $article2_oid, '... got a oid for the article'); + isnt($article2_ref, "$article2", '... got a new article instance'); + + is($article2->headline, + 'Company wins Lottery', + '... got the right headline'); + is($article2->summary, + 'An email was received today that informed the company we have won the lottery', + '... got the right summary'); + is($article2->article, 'WoW', '... got the right article'); + + ok(!$article2->start_date, '... these two dates are unassigned'); + ok(!$article2->end_date, '... these two dates are unassigned'); + + isa_ok($article2->author, 'Newswriter::Author'); + is($article2->author->first_name, 'Katie', '... got the right author first name'); + is($article2->author->last_name, 'Couric', '... got the right author last name'); + + is($article2->status, 'posted', '... got the right status'); + +} + +done_testing; diff --git a/t/200_examples/003_example.t b/t/200_examples/003_example.t index 879fc3b..5fa7d3c 100644 --- a/t/200_examples/003_example.t +++ b/t/200_examples/003_example.t @@ -1,9 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 30; +use Test::More; use Test::Exception; sub U { @@ -154,10 +157,4 @@ sub Y { is($coll2->print, '1, 4, 9, 16, 25, 36, 49, 64, 81, 100', '... new collection is changed'); } - - - - - - - +done_testing; diff --git a/t/200_examples/004_example_w_DCS.t b/t/200_examples/004_example_w_DCS.t index 58cd3e7..1ec0149 100644 --- a/t/200_examples/004_example_w_DCS.t +++ b/t/200_examples/004_example_w_DCS.t @@ -1,4 +1,7 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; @@ -14,11 +17,9 @@ Pretty well if I do say so myself :) =cut -BEGIN { - eval "use Declare::Constraints::Simple;"; - plan skip_all => "Declare::Constraints::Simple is required for this test" if $@; - plan tests => 9; -} +use Test::Requires { + 'Declare::Constraints::Simple' => '0.01', # skip all if not installed +}; use Test::Exception; @@ -91,3 +92,4 @@ dies_ok { $foo->baz({}); } '... validation failed correctly'; +done_testing; diff --git a/t/200_examples/005_example_w_TestDeep.t b/t/200_examples/005_example_w_TestDeep.t index 604b78f..1cde437 100644 --- a/t/200_examples/005_example_w_TestDeep.t +++ b/t/200_examples/005_example_w_TestDeep.t @@ -1,4 +1,7 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; @@ -15,11 +18,9 @@ but it is not completely horrid either. =cut -BEGIN { - eval "use Test::Deep;"; - plan skip_all => "Test::Deep is required for this test" if $@; - plan tests => 5; -} +use Test::Requires { + 'Test::Deep' => '0.01', # skip all if not installed +}; use Test::Exception; @@ -75,4 +76,4 @@ dies_ok { $foo->bar([{ foo => 3 }]); } '... validation failed correctly'; - +done_testing; diff --git a/t/200_examples/0071_Child_Parent_attr_inherit_imm.t b/t/200_examples/0071_Child_Parent_attr_inherit_imm.t deleted file mode 100644 index 4a5a3bd..0000000 --- a/t/200_examples/0071_Child_Parent_attr_inherit_imm.t +++ /dev/null @@ -1,137 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; - -use Test::More tests => 23; - -=pod - -Some examples of triggers and how they can -be used to manage parent-child relationships. - -=cut - -{ - - package Parent; - use Mouse; - - has 'last_name' => ( - is => 'rw', - isa => 'Str', - trigger => sub { - my $self = shift; - - # if the parents last-name changes - # then so do all the childrens - foreach my $child ( @{ $self->children } ) { - $child->last_name( $self->last_name ); - } - } - ); - - has 'children' => - ( is => 'rw', isa => 'ArrayRef', default => sub { [] } ); - __PACKAGE__->meta->make_immutable(); -} -{ - - package Child; - use Mouse; - - has 'parent' => ( - is => 'rw', - isa => 'Parent', - required => 1, - trigger => sub { - my $self = shift; - - # if the parent is changed,.. - # make sure we update - $self->last_name( $self->parent->last_name ); - } - ); - - has 'last_name' => ( - is => 'rw', - isa => 'Str', - lazy => 1, - default => sub { (shift)->parent->last_name } - ); - __PACKAGE__->meta->make_immutable(); -} - -my $parent = Parent->new( last_name => 'Smith' ); -isa_ok( $parent, 'Parent' ); - -is( $parent->last_name, 'Smith', - '... the parent has the last name we expected' ); - -$parent->children( [ map { Child->new( parent => $parent ) } ( 0 .. 3 ) ] ); - -foreach my $child ( @{ $parent->children } ) { - is( $child->last_name, $parent->last_name, - '... parent and child have the same last name (' - . $parent->last_name - . ')' ); -} - -$parent->last_name('Jones'); -is( $parent->last_name, 'Jones', '... the parent has the new last name' ); - -foreach my $child ( @{ $parent->children } ) { - is( $child->last_name, $parent->last_name, - '... parent and child have the same last name (' - . $parent->last_name - . ')' ); -} - -# make a new parent - -my $parent2 = Parent->new( last_name => 'Brown' ); -isa_ok( $parent2, 'Parent' ); - -# orphan the child - -my $orphan = pop @{ $parent->children }; - -# and then the new parent adopts it - -$orphan->parent($parent2); - -foreach my $child ( @{ $parent->children } ) { - is( $child->last_name, $parent->last_name, - '... parent and child have the same last name (' - . $parent->last_name - . ')' ); -} - -isnt( $orphan->last_name, $parent->last_name, - '... the orphan child does not have the same last name anymore (' - . $parent2->last_name - . ')' ); -is( $orphan->last_name, $parent2->last_name, - '... parent2 and orphan child have the same last name (' - . $parent2->last_name - . ')' ); - -# make sure that changes still will not propagate - -$parent->last_name('Miller'); -is( $parent->last_name, 'Miller', - '... the parent has the new last name (again)' ); - -foreach my $child ( @{ $parent->children } ) { - is( $child->last_name, $parent->last_name, - '... parent and child have the same last name (' - . $parent->last_name - . ')' ); -} - -isnt( $orphan->last_name, $parent->last_name, - '... the orphan child is not affected by changes in the parent anymore' ); -is( $orphan->last_name, $parent2->last_name, - '... parent2 and orphan child have the same last name (' - . $parent2->last_name - . ')' ); diff --git a/t/200_examples/007_Child_Parent_attr_inherit.t b/t/200_examples/007_Child_Parent_attr_inherit.t index e41a568..c5f4b4e 100644 --- a/t/200_examples/007_Child_Parent_attr_inherit.t +++ b/t/200_examples/007_Child_Parent_attr_inherit.t @@ -1,9 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 23; +use Test::More; =pod @@ -134,3 +137,5 @@ is( $orphan->last_name, $parent2->last_name, '... parent2 and orphan child have the same last name (' . $parent2->last_name . ')' ); + +done_testing; diff --git a/t/200_examples/008_record_set_iterator.t b/t/200_examples/008_record_set_iterator.t index aebe61c..d290b73 100644 --- a/t/200_examples/008_record_set_iterator.t +++ b/t/200_examples/008_record_set_iterator.t @@ -1,13 +1,15 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 8; +use Test::More; use Test::Exception; - { package Record; use Mouse; @@ -115,13 +117,4 @@ $rsi->get_next_record; is($rsi->first_name, 'Jim', '... got the right first name'); is($rsi->last_name, 'Johnson', '... got the right last name'); - - - - - - - - - - +done_testing; diff --git a/t/300_immutable/001_immutable_moose.t b/t/300_immutable/001_immutable_moose.t index 2d72554..4545901 100644 --- a/t/300_immutable/001_immutable_moose.t +++ b/t/300_immutable/001_immutable_moose.t @@ -1,16 +1,17 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 15; +use Test::More; +$TODO = q{Mouse is not yet completed}; use Test::Exception; -use Test::Mouse; use Mouse::Meta::Role; -use lib 't/lib'; -use MooseCompat; { package FooRole; @@ -44,10 +45,8 @@ use MooseCompat; is( Foo->new->bazes, 'many bazes', "correct value for 'bazes' before inlining constructor" ); lives_ok { $meta->make_immutable } "Foo is imutable"; - lives_ok { $meta->identifier } "->identifier on metaclass lives"; dies_ok { $meta->add_role($foo_role) } "Add Role is locked"; - lives_ok { Foo->new } "Inlined constructor works with lazy_build"; is( Foo->new->foos, 'many foos', "correct value for 'foos' after inlining constructor" ); @@ -55,11 +54,8 @@ use MooseCompat; "correct value for 'bars' after inlining constructor" ); is( Foo->new->bazes, 'many bazes', "correct value for 'bazes' after inlining constructor" ); - SKIP: { - skip "Mouse doesn't supports make_mutable", 2; - lives_ok { $meta->make_mutable } "Foo is mutable"; - lives_ok { $meta->add_role($foo_role) } "Add Role is unlocked"; - }; + lives_ok { $meta->make_mutable } "Foo is mutable"; + lives_ok { $meta->add_role($foo_role) } "Add Role is unlocked"; } @@ -92,3 +88,5 @@ lives_ok { Baz->meta->make_immutable } Nothing here yet, but soon :) =cut + +done_testing; diff --git a/t/300_immutable/002_apply_roles_to_immutable.t b/t/300_immutable/002_apply_roles_to_immutable.t new file mode 100644 index 0000000..e003a42 --- /dev/null +++ b/t/300_immutable/002_apply_roles_to_immutable.t @@ -0,0 +1,43 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; +use Test::Exception; + + +{ + package My::Role; + use Mouse::Role; + + around 'baz' => sub { + my $next = shift; + 'My::Role::baz(' . $next->(@_) . ')'; + }; +} + +{ + package Foo; + use Mouse; + + sub baz { 'Foo::baz' } + + __PACKAGE__->meta->make_immutable(debug => 0); +} + +my $foo = Foo->new; +isa_ok($foo, 'Foo'); + +is($foo->baz, 'Foo::baz', '... got the right value'); + +lives_ok { + My::Role->meta->apply($foo) +} '... successfully applied the role to immutable instance'; + +is($foo->baz, 'My::Role::baz(Foo::baz)', '... got the right value'); + +done_testing; diff --git a/t/300_immutable/003_immutable_meta_class.t b/t/300_immutable/003_immutable_meta_class.t new file mode 100644 index 0000000..3728be1 --- /dev/null +++ b/t/300_immutable/003_immutable_meta_class.t @@ -0,0 +1,30 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; +use Test::Exception; + + +{ + package My::Meta; + + use Mouse; + + extends 'Mouse::Meta::Class'; + + has 'meta_size' => ( + is => 'rw', + isa => 'Int', + ); +} + +lives_ok { + My::Meta->meta()->make_immutable(debug => 0) +} '... can make a meta class immutable'; + +done_testing; diff --git a/t/300_immutable/004_inlined_constructors_n_types.t b/t/300_immutable/004_inlined_constructors_n_types.t index afee861..93967aa 100644 --- a/t/300_immutable/004_inlined_constructors_n_types.t +++ b/t/300_immutable/004_inlined_constructors_n_types.t @@ -1,9 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 10; +use Test::More; use Test::Exception; =pod @@ -11,7 +14,7 @@ use Test::Exception; This tests to make sure that the inlined constructor has all the type constraints in order, even in the cases when there is no type constraint available, such -as with a Class::MOP::Attribute object. +as with a Mouse::Meta::Attribute object. =cut @@ -59,5 +62,4 @@ for (1..2) { Foo->meta->make_immutable(debug => 0) unless $is_immutable; } - - +done_testing; diff --git a/t/300_immutable/005_multiple_demolish_inline.t b/t/300_immutable/005_multiple_demolish_inline.t index 7b70107..a6d2f29 100644 --- a/t/300_immutable/005_multiple_demolish_inline.t +++ b/t/300_immutable/005_multiple_demolish_inline.t @@ -1,13 +1,15 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 5; +use Test::More; use Test::Exception; - { package Foo; use Mouse; @@ -44,3 +46,5 @@ lives_ok { is( Foo->meta->get_method('DESTROY')->package_name, 'Foo', 'Foo has a DESTROY method in the Bar class (not inherited)' ); + +done_testing; diff --git a/t/300_immutable/007_immutable_trigger_from_constructor.t b/t/300_immutable/007_immutable_trigger_from_constructor.t index 0ddcc5f..6e5cdb1 100644 --- a/t/300_immutable/007_immutable_trigger_from_constructor.t +++ b/t/300_immutable/007_immutable_trigger_from_constructor.t @@ -1,4 +1,7 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; @@ -6,7 +9,6 @@ use warnings; use Test::More; use Test::Exception; -plan tests => 3; { package AClass; @@ -16,12 +18,12 @@ plan tests => 3; has 'foo' => (is => 'rw', isa => 'Maybe[Str]', trigger => sub { die "Pulling the Foo trigger\n" }); - - has 'bar' => (is => 'rw', isa => 'Maybe[Str]'); - + + has 'bar' => (is => 'rw', isa => 'Maybe[Str]'); + has 'baz' => (is => 'rw', isa => 'Maybe[Str]', trigger => sub { die "Pulling the Baz trigger\n" - }); + }); __PACKAGE__->meta->make_immutable; #(debug => 1); @@ -36,5 +38,4 @@ like ($@, qr/^Pulling the Baz trigger/, "trigger from immutable constructor"); lives_ok { AClass->new(bar => 'bar') } '... no triggers called'; - - +done_testing; diff --git a/t/300_immutable/008_immutable_constructor_error.t b/t/300_immutable/008_immutable_constructor_error.t index d4af493..521d2f4 100644 --- a/t/300_immutable/008_immutable_constructor_error.t +++ b/t/300_immutable/008_immutable_constructor_error.t @@ -1,13 +1,15 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 2; +use Test::More; use Test::Exception; - =pod This tests to make sure that we provide the same error messages from @@ -30,4 +32,7 @@ throws_ok { Foo->new($scalar) } qr/\QSingle parameters to new() must be a HASH r 'Non-ref provided to immutable constructor gives useful error message'; throws_ok { Foo->new(\$scalar) } qr/\QSingle parameters to new() must be a HASH ref/, 'Scalar ref provided to immutable constructor gives useful error message'; +throws_ok { Foo->new(undef) } qr/\QSingle parameters to new() must be a HASH ref/, + 'undef provided to immutable constructor gives useful error message'; +done_testing; diff --git a/t/300_immutable/009_buildargs.t b/t/300_immutable/009_buildargs.t index 5f9a10a..b1e433b 100644 --- a/t/300_immutable/009_buildargs.t +++ b/t/300_immutable/009_buildargs.t @@ -1,16 +1,19 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 14; +use Test::More; { package Foo; use Mouse; has bar => ( is => "rw" ); - has baz => ( is => "rw" ); + has baz => ( is => "rw" ); sub BUILDARGS { my ( $self, @args ) = @_; @@ -24,7 +27,7 @@ use Test::More tests => 14; use Mouse; extends qw(Foo); - + __PACKAGE__->meta->make_immutable; } @@ -32,12 +35,16 @@ foreach my $class qw(Foo Bar) { is( $class->new->bar, undef, "no args" ); is( $class->new( bar => 42 )->bar, 42, "normal args" ); is( $class->new( 37 )->bar, 37, "single arg" ); - my $o = $class->new(bar => 42, baz => 47); - is($o->bar, 42, '... got the right bar'); - is($o->baz, 47, '... got the right bar'); - my $ob = $class->new(42, baz => 47); - is($ob->bar, 42, '... got the right bar'); - is($ob->baz, 47, '... got the right bar'); + { + my $o = $class->new(bar => 42, baz => 47); + is($o->bar, 42, '... got the right bar'); + is($o->baz, 47, '... got the right bar'); + } + { + my $o = $class->new(42, baz => 47); + is($o->bar, 42, '... got the right bar'); + is($o->baz, 47, '... got the right bar'); + } } - +done_testing; diff --git a/t/300_immutable/010_constructor_is_not_moose.t b/t/300_immutable/010_constructor_is_not_moose.t new file mode 100644 index 0000000..040a39b --- /dev/null +++ b/t/300_immutable/010_constructor_is_not_moose.t @@ -0,0 +1,108 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; + +use Test::Requires { + 'Test::Output' => '0.01', # skip all if not installed +}; + +{ + package NotMoose; + + sub new { + my $class = shift; + + return bless { not_moose => 1 }, $class; + } +} + +{ + package Foo; + use Mouse; + + extends 'NotMoose'; + + ::stderr_like( + sub { Foo->meta->make_immutable }, + qr/\QNot inlining 'new' for Foo since it is not inheriting the default Mouse::Object::new\E\s+\QIf you are certain you don't need to inline your constructor, specify inline_constructor => 0 in your call to Foo->meta->make_immutable/, + 'got a warning that Foo may not have an inlined constructor' + ); +} + +is( + Foo->meta->find_method_by_name('new')->body, + NotMoose->can('new'), + 'Foo->new is inherited from NotMoose' +); + +{ + package Bar; + use Mouse; + + extends 'NotMoose'; + + ::stderr_is( + sub { Bar->meta->make_immutable( replace_constructor => 1 ) }, + q{}, + 'no warning when replace_constructor is true' + ); +} + +is( + Bar->meta->find_method_by_name('new')->package_name, + 'Bar', + 'Bar->new is inlined, and not inherited from NotMoose' +); + +{ + package Baz; + use Mouse; + + Baz->meta->make_immutable; +} + +{ + package Quux; + use Mouse; + + extends 'Baz'; + + ::stderr_is( + sub { Quux->meta->make_immutable }, + q{}, + 'no warning when inheriting from a class that has already made itself immutable' + ); +} + +{ + package My::Constructor; + use base 'Mouse::Meta::Method'; +} + +{ + package CustomCons; + use Mouse; + + CustomCons->meta->make_immutable( constructor_class => 'My::Constructor' ); +} + +{ + package Subclass; + use Mouse; + + extends 'CustomCons'; + + ::stderr_is( + sub { Subclass->meta->make_immutable }, + q{}, + 'no warning when inheriting from a class that has already made itself immutable' + ); +} + +done_testing; diff --git a/t/300_immutable/011_constructor_is_wrapped.t b/t/300_immutable/011_constructor_is_wrapped.t new file mode 100644 index 0000000..efd2597 --- /dev/null +++ b/t/300_immutable/011_constructor_is_wrapped.t @@ -0,0 +1,35 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; + +use Test::Requires { + 'Test::Output' => '0.01', # skip all if not installed +}; + +{ + package ModdedNew; + use Mouse; + + before 'new' => sub { }; +} + +{ + package Foo; + use Mouse; + + extends 'ModdedNew'; + + ::stderr_like( + sub { Foo->meta->make_immutable }, + qr/\QNot inlining 'new' for Foo since it has method modifiers which would be lost if it were inlined/, + 'got a warning that Foo may not have an inlined constructor' + ); +} + +done_testing; diff --git a/t/300_immutable/012_default_values.t b/t/300_immutable/012_default_values.t new file mode 100644 index 0000000..aca9bf8 --- /dev/null +++ b/t/300_immutable/012_default_values.t @@ -0,0 +1,69 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; +use Test::Exception; + +{ + + package Foo; + use Mouse; + + has 'foo' => ( is => 'rw', default => q{'} ); + has 'bar' => ( is => 'rw', default => q{\\} ); + has 'baz' => ( is => 'rw', default => q{"} ); + has 'buz' => ( is => 'rw', default => q{"'\\} ); + has 'faz' => ( is => 'rw', default => qq{\0} ); + + ::lives_ok { __PACKAGE__->meta->make_immutable } + 'no errors making a package immutable when it has default values that could break quoting'; +} + +my $foo = Foo->new; +is( $foo->foo, q{'}, + 'default value for foo attr' ); +is( $foo->bar, q{\\}, + 'default value for bar attr' ); +is( $foo->baz, q{"}, + 'default value for baz attr' ); +is( $foo->buz, q{"'\\}, + 'default value for buz attr' ); +is( $foo->faz, qq{\0}, + 'default value for faz attr' ); + + +# Lazy attrs were never broken, but it doesn't hurt to test that they +# won't be broken by any future changes. +{ + + package Bar; + use Mouse; + + has 'foo' => ( is => 'rw', default => q{'}, lazy => 1 ); + has 'bar' => ( is => 'rw', default => q{\\}, lazy => 1 ); + has 'baz' => ( is => 'rw', default => q{"}, lazy => 1 ); + has 'buz' => ( is => 'rw', default => q{"'\\}, lazy => 1 ); + has 'faz' => ( is => 'rw', default => qq{\0}, lazy => 1 ); + + ::lives_ok { __PACKAGE__->meta->make_immutable } + 'no errors making a package immutable when it has lazy default values that could break quoting'; +} + +my $bar = Bar->new; +is( $bar->foo, q{'}, + 'default value for foo attr' ); +is( $bar->bar, q{\\}, + 'default value for bar attr' ); +is( $bar->baz, q{"}, + 'default value for baz attr' ); +is( $bar->buz, q{"'\\}, + 'default value for buz attr' ); +is( $bar->faz, qq{\0}, + 'default value for faz attr' ); + +done_testing; diff --git a/t/300_immutable/013_immutable_roundtrip.t b/t/300_immutable/013_immutable_roundtrip.t new file mode 100644 index 0000000..04a4b24 --- /dev/null +++ b/t/300_immutable/013_immutable_roundtrip.t @@ -0,0 +1,41 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; + +use Test::Requires { + 'Test::Output' => '0.01', # skip all if not installed +}; + +{ + package Foo; + use Mouse; + __PACKAGE__->meta->make_immutable; +} + +{ + package Bar; + use Mouse; + + extends 'Foo'; + + __PACKAGE__->meta->make_immutable; + __PACKAGE__->meta->make_mutable; + + + # This actually is testing for a bug in Mouse::Meta that cause + # Mouse::Meta::Method to spit out a warning when it + # shouldn't have done so. The bug was fixed in CMOP 0.75. + ::stderr_unlike( + sub { Bar->meta->make_immutable }, + qr/Not inlining a constructor/, + 'no warning that Bar may not have an inlined constructor' + ); +} + +done_testing; diff --git a/t/300_immutable/014_immutable_metaclass_with_traits.t b/t/300_immutable/014_immutable_metaclass_with_traits.t new file mode 100644 index 0000000..30098cb --- /dev/null +++ b/t/300_immutable/014_immutable_metaclass_with_traits.t @@ -0,0 +1,41 @@ +#!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use strict; +use warnings; +use Test::More; +$TODO = q{Mouse is not yet completed}; + +{ + package FooTrait; + use Mouse::Role; +} +{ + package Foo; + use Mouse -traits => ['FooTrait']; +} + +is(Mouse::Util::class_of('Foo'), Foo->meta, + "class_of and ->meta are the same on Foo"); +my $meta = Foo->meta; +is(Mouse::Util::class_of($meta), $meta->meta, + "class_of and ->meta are the same on Foo's metaclass"); +isa_ok(Mouse::Util::class_of($meta), 'Mouse::Meta::Class'); +isa_ok($meta->meta, 'Mouse::Meta::Class'); +ok($meta->is_mutable, "class is mutable"); +ok(Mouse::Util::class_of($meta)->is_mutable, "metaclass is mutable"); +ok($meta->meta->does_role('FooTrait'), "does the trait"); +Foo->meta->make_immutable; +is(Mouse::Util::class_of('Foo'), Foo->meta, + "class_of and ->meta are the same on Foo (immutable)"); +$meta = Foo->meta; +isa_ok($meta->meta, 'Mouse::Meta::Class'); +ok($meta->is_immutable, "class is immutable"); +ok($meta->meta->is_immutable, "metaclass is immutable (immutable class)"); +is(Mouse::Util::class_of($meta), $meta->meta, + "class_of and ->meta are the same on Foo's metaclass (immutable)"); +isa_ok(Mouse::Util::class_of($meta), 'Mouse::Meta::Class'); +ok($meta->meta->does_role('FooTrait'), "still does the trait after immutable"); + +done_testing; diff --git a/t/300_immutable/015_immutable_destroy.t b/t/300_immutable/015_immutable_destroy.t new file mode 100644 index 0000000..cfd0dd6 --- /dev/null +++ b/t/300_immutable/015_immutable_destroy.t @@ -0,0 +1,25 @@ +use strict; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use warnings; +use Test::More; +$TODO = q{Mouse is not yet completed}; + +{ + package FooBar; + use Mouse; + + has 'name' => ( is => 'ro' ); + + sub DESTROY { shift->name } + + local $SIG{__WARN__} = sub {}; + __PACKAGE__->meta->make_immutable; +} + +my $f = FooBar->new( name => 'SUSAN' ); + +is( $f->DESTROY, 'SUSAN', 'Did moose overload DESTROY?' ); + +done_testing; diff --git a/t/300_immutable/016_inline_fallbacks.t b/t/300_immutable/016_inline_fallbacks.t new file mode 100644 index 0000000..8a5635b --- /dev/null +++ b/t/300_immutable/016_inline_fallbacks.t @@ -0,0 +1,73 @@ +use strict; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use warnings; +use Test::More; + +{ + package Foo; + use Mouse; + has foo => (is => 'ro'); +} + +{ + package Foo::Sub; + use Mouse; + extends 'Foo'; + has bar => (is => 'ro'); +} + +{ + my $foo = Foo::Sub->new(foo => 12, bar => 25); + is($foo->foo, 12, 'got right value for foo'); + is($foo->bar, 25, 'got right value for bar'); +} + +Foo->meta->make_immutable; + +{ + package Foo::Sub2; + use Mouse; + extends 'Foo'; + has baz => (is => 'ro'); + # not making immutable, inheriting Foo's inlined constructor +} + +{ + my $foo = Foo::Sub2->new(foo => 42, baz => 27); + is($foo->foo, 42, 'got right value for foo'); + is($foo->baz, 27, 'got right value for baz'); +} + +my $BAR = 0; +{ + package Bar; + use Mouse; +} + +{ + package Bar::Sub; + use Mouse; + extends 'Bar'; + sub DEMOLISH { $BAR++ } +} + +Bar::Sub->new; +is($BAR, 1, 'DEMOLISH in subclass was called'); +$BAR = 0; + +Bar->meta->make_immutable; + +{ + package Bar::Sub2; + use Mouse; + extends 'Bar'; + sub DEMOLISH { $BAR++ } + # not making immutable, inheriting Bar's inlined destructor +} + +Bar::Sub2->new; +is($BAR, 1, 'DEMOLISH in subclass was called'); + +done_testing; diff --git a/t/300_immutable/101-immutable-default.t b/t/300_immutable/101-immutable-default.t deleted file mode 100644 index 6fcbf2b..0000000 --- a/t/300_immutable/101-immutable-default.t +++ /dev/null @@ -1,27 +0,0 @@ -use strict; -use warnings; - -use Test::More tests => 5; -use Test::Exception; - -{ - package Foo; - use Mouse; - - #two checks because the inlined methods are different when - #there is a TC present. - has 'foos' => ( is => 'rw', default => 'DEFAULT' ); - has 'bars' => ( is => 'rw', default => 300100 ); - has 'bazs' => ( is => 'rw', default => sub { +{} } ); - -} - -lives_ok { Foo->meta->make_immutable } - 'Immutable meta with single BUILD'; - -my $f = Foo->new; -isa_ok $f, 'Foo'; -is $f->foos, 'DEFAULT', 'str default'; -is $f->bars, 300100, 'int default'; -is ref($f->bazs), 'HASH', 'code default'; - diff --git a/t/400_moose_util/001_moose_util.t b/t/400_moose_util/001_moose_util.t new file mode 100644 index 0000000..4083ca9 --- /dev/null +++ b/t/400_moose_util/001_moose_util.t @@ -0,0 +1,15 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; + +BEGIN { + use_ok('Mouse::Util'); +} + +done_testing; diff --git a/t/400_mouse_util/002_mouse_util_does_role.t b/t/400_moose_util/002_moose_util_does_role.t similarity index 83% rename from t/400_mouse_util/002_mouse_util_does_role.t rename to t/400_moose_util/002_moose_util_does_role.t index ac2c304..4851e6a 100644 --- a/t/400_mouse_util/002_mouse_util_does_role.t +++ b/t/400_moose_util/002_moose_util_does_role.t @@ -1,9 +1,12 @@ #!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use strict; use warnings; -use Test::More tests => 8; +use Test::More; BEGIN { use_ok('Mouse::Util', ':all'); @@ -32,7 +35,7 @@ BEGIN { { package Quux; - #use metaclass; + use metaclass; } { @@ -79,3 +82,4 @@ ok(!does_role('Quux', 'Foo'), '... Quux doesnt do Foo (does not die tho)'); #ok(does_role('Foo::Foo', 'Foo'), '... Foo::Foo does do Foo'); +done_testing; diff --git a/t/400_moose_util/007_apply_roles.t b/t/400_moose_util/007_apply_roles.t new file mode 100644 index 0000000..a6b33b7 --- /dev/null +++ b/t/400_moose_util/007_apply_roles.t @@ -0,0 +1,74 @@ +use strict; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use warnings; + +use Test::More; +use Mouse::Util qw( apply_all_roles ); + +{ + package Role::Foo; + use Mouse::Role; +} + +{ + package Role::Bar; + use Mouse::Role; +} + +{ + package Role::Baz; + use Mouse::Role; +} + +{ + package Class::A; + use Mouse; +} + +{ + package Class::B; + use Mouse; +} + +{ + package Class::C; + use Mouse; +} + +{ + package Class::D; + use Mouse; +} + +{ + package Class::E; + use Mouse; +} + +my @roles = qw( Role::Foo Role::Bar Role::Baz ); +apply_all_roles( 'Class::A', @roles ); +ok( Class::A->meta->does_role($_), "Class::A does $_" ) for @roles; + +apply_all_roles( 'Class::B', map { $_->meta } @roles ); +ok( Class::A->meta->does_role($_), + "Class::B does $_ (applied with meta role object)" ) + for @roles; + +@roles = qw( Role::Foo ); +apply_all_roles( 'Class::C', @roles ); +ok( Class::A->meta->does_role($_), "Class::C does $_" ) for @roles; + +apply_all_roles( 'Class::D', map { $_->meta } @roles ); +ok( Class::A->meta->does_role($_), + "Class::D does $_ (applied with meta role object)" ) + for @roles; + +@roles = qw( Role::Foo Role::Bar ), Role::Baz->meta; +apply_all_roles( 'Class::E', @roles ); +ok( Class::A->meta->does_role($_), + "Class::E does $_ (mix of names and meta role object)" ) + for @roles; + +done_testing; diff --git a/t/500_test_moose/001_test_moose.t b/t/500_test_moose/001_test_moose.t new file mode 100644 index 0000000..2d70ec8 --- /dev/null +++ b/t/500_test_moose/001_test_moose.t @@ -0,0 +1,15 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; + +BEGIN { + use_ok('Test::Mouse'); +} + +done_testing; diff --git a/t/500_test_moose/002_test_moose_does_ok.t b/t/500_test_moose/002_test_moose_does_ok.t new file mode 100644 index 0000000..feb4a2f --- /dev/null +++ b/t/500_test_moose/002_test_moose_does_ok.t @@ -0,0 +1,65 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::Builder::Tester; +use Test::More; + +BEGIN { + use_ok('Test::Mouse'); +} + +{ + package Foo; + use Mouse::Role; +} + +{ + package Bar; + use Mouse; + + with qw/Foo/; +} + +{ + package Baz; + use Mouse; +} + +# class ok + +test_out('ok 1 - does_ok class'); + +does_ok('Bar','Foo','does_ok class'); + +# class fail + +test_out ('not ok 2 - does_ok class fail'); +test_fail (+2); + +does_ok('Baz','Foo','does_ok class fail'); + +# object ok + +my $bar = Bar->new; + +test_out ('ok 3 - does_ok object'); + +does_ok ($bar,'Foo','does_ok object'); + +# object fail + +my $baz = Baz->new; + +test_out ('not ok 4 - does_ok object fail'); +test_fail (+2); + +does_ok ($baz,'Foo','does_ok object fail'); + +test_test ('does_ok'); + +done_testing; diff --git a/t/500_test_moose/003_test_moose_has_attribute_ok.t b/t/500_test_moose/003_test_moose_has_attribute_ok.t new file mode 100644 index 0000000..f652830 --- /dev/null +++ b/t/500_test_moose/003_test_moose_has_attribute_ok.t @@ -0,0 +1,52 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::Builder::Tester; +use Test::More; + +BEGIN { + use_ok('Test::Mouse'); +} + +{ + package Foo; + use Mouse; + + has 'foo', is => 'bare'; +} + +{ + package Bar; + use Mouse; + + extends 'Foo'; + + has 'bar', is => 'bare'; +} + + +test_out('ok 1 - ... has_attribute_ok(Foo, foo) passes'); + +has_attribute_ok('Foo', 'foo', '... has_attribute_ok(Foo, foo) passes'); + +test_out ('not ok 2 - ... has_attribute_ok(Foo, bar) fails'); +test_fail (+2); + +has_attribute_ok('Foo', 'bar', '... has_attribute_ok(Foo, bar) fails'); + +test_out('ok 3 - ... has_attribute_ok(Bar, foo) passes'); + +has_attribute_ok('Bar', 'foo', '... has_attribute_ok(Bar, foo) passes'); + +test_out('ok 4 - ... has_attribute_ok(Bar, bar) passes'); + +has_attribute_ok('Bar', 'bar', '... has_attribute_ok(Bar, bar) passes'); + +test_test ('has_attribute_ok'); + +done_testing; diff --git a/t/500_test_moose/004_test_moose_meta_ok.t b/t/500_test_moose/004_test_moose_meta_ok.t new file mode 100644 index 0000000..dc3141e --- /dev/null +++ b/t/500_test_moose/004_test_moose_meta_ok.t @@ -0,0 +1,36 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::Builder::Tester; +use Test::More; + +BEGIN { + use_ok('Test::Mouse'); +} + +{ + package Foo; + use Mouse; +} + +{ + package Bar; +} + +test_out('ok 1 - ... meta_ok(Foo) passes'); + +meta_ok('Foo', '... meta_ok(Foo) passes'); + +test_out ('not ok 2 - ... meta_ok(Bar) fails'); +test_fail (+2); + +meta_ok('Bar', '... meta_ok(Bar) fails'); + +test_test ('meta_ok'); + +done_testing; diff --git a/t/500_test_moose/005_with_immutable.t b/t/500_test_moose/005_with_immutable.t new file mode 100644 index 0000000..cab3a7b --- /dev/null +++ b/t/500_test_moose/005_with_immutable.t @@ -0,0 +1,43 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::Builder::Tester; +use Test::More; + +BEGIN { + use_ok('Test::Mouse'); +} + +{ + package Foo; + use Mouse; +} + +{ + package Bar; + use Mouse; +} + +package main; + +test_out("ok 1", "not ok 2"); +test_fail(+2); +my $ret = with_immutable { + ok(Foo->meta->is_mutable); +} qw(Foo); +test_test('with_immutable failure'); +ok(!$ret, "one of our tests failed"); + +test_out("ok 1", "ok 2"); +$ret = with_immutable { + ok(Bar->meta->find_method_by_name('new')); +} qw(Bar); +test_test('with_immutable success'); +ok($ret, "all tests succeeded"); + +done_testing; diff --git a/t/600_todo_tests/001_exception_reflects_failed_constraint.t b/t/600_todo_tests/001_exception_reflects_failed_constraint.t new file mode 100644 index 0000000..f96b472 --- /dev/null +++ b/t/600_todo_tests/001_exception_reflects_failed_constraint.t @@ -0,0 +1,38 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +# In the case where a child type constraint's parent constraint fails, +# the exception should reference the parent type constraint that actually +# failed instead of always referencing the child'd type constraint + +use strict; +use warnings; + +use Test::More; +use Test::Exception; + +BEGIN { + use_ok('Mouse::Util::TypeConstraints'); +} + +lives_ok { + subtype 'ParentConstraint' => as 'Str' => where {0}; +} 'specified parent type constraint'; + +my $tc; +lives_ok { + $tc = subtype 'ChildConstraint' => as 'ParentConstraint' => where {1}; +} 'specified child type constraint'; + +{ + my $errmsg = $tc->validate(); + + TODO: { + local $TODO = 'Not yet supported'; + ok($errmsg !~ /Validation failed for 'ChildConstraint'/, 'exception references failing parent constraint'); + }; +} + +done_testing; diff --git a/t/600_todo_tests/003_immutable_n_around.t b/t/600_todo_tests/003_immutable_n_around.t new file mode 100644 index 0000000..3ff04b5 --- /dev/null +++ b/t/600_todo_tests/003_immutable_n_around.t @@ -0,0 +1,60 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; +$TODO = q{Mouse is not yet completed}; + +# if make_immutable is removed from the following code the tests pass + +{ + package Foo; + use Mouse; + + has foo => ( is => "ro" ); + + package Bar; + use Mouse; + + extends qw(Foo); + + around new => sub { + my $next = shift; + my ( $self, @args ) = @_; + $self->$next( foo => 42 ); + }; + + package Gorch; + use Mouse; + + extends qw(Bar); + + package Zoink; + use Mouse; + + extends qw(Gorch); + +} + +my @classes = qw(Foo Bar Gorch Zoink); + +tests: { + TODO: { + is( Foo->new->foo, undef, "base class (" . (Foo->meta->is_immutable ? "immutable" : "mutable") . ")" ); + is( Bar->new->foo, 42, "around new called on Bar->new (" . (Bar->meta->is_immutable ? "immutable" : "mutable") . ")" ); + is( Gorch->new->foo, 42, "around new called on Gorch->new (" . (Gorch->meta->is_immutable ? "immutable" : "mutable") . ")" ); + is( Zoink->new->foo, 42, "around new called Zoink->new (" . (Zoink->meta->is_immutable ? "immutable" : "mutable") . ")" ); + } + + if ( @classes ) { + local $SIG{__WARN__} = sub {}; + ( shift @classes )->meta->make_immutable; + redo tests; + } +} + +done_testing; diff --git a/t/600_todo_tests/005_moose_and_threads.t b/t/600_todo_tests/005_moose_and_threads.t new file mode 100644 index 0000000..4eac399 --- /dev/null +++ b/t/600_todo_tests/005_moose_and_threads.t @@ -0,0 +1,44 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; +use Test::Exception; + + +=pod + +See this for some details: + +http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=476579 + +Here is the basic test case, it segfaults, so I am going +to leave it commented out. Basically it seems that there +is some bad interaction between the ??{} construct that +is used in the "parser" for type definitions and threading +so probably the fix would involve removing the ??{} usage +for something else. + +use threads; + +{ + package Foo; + use Mouse; + has "bar" => (is => 'rw', isa => "Str | Num"); +} + +my $thr = threads->create(sub {}); +$thr->join(); + +=cut + +{ + local $TODO = 'This is just a stub for the test, see the POD'; + fail('Mouse type constraints and threads dont get along'); +} + +done_testing; 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..178572f --- /dev/null +++ b/t/600_todo_tests/006_required_role_accessors.t @@ -0,0 +1,61 @@ +#!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use strict; +use warnings; +use Test::More; +use Test::Exception; + +{ + package Foo::API; + use Mouse::Role; + + requires 'foo'; +} + +{ + package Foo; + use Mouse::Role; + + has foo => (is => 'ro'); + + with 'Foo::API'; +} + +{ + package Foo::Class; + use Mouse; + { our $TODO; local $TODO = "role accessors don't satisfy other role requires"; + ::lives_ok { with 'Foo' } 'requirements are satisfied properly'; + } +} + +{ + package Bar; + use Mouse::Role; + + requires 'baz'; + + has bar => (is => 'ro'); +} + +{ + package Baz; + use Mouse::Role; + + requires 'bar'; + + has baz => (is => 'ro'); +} + +{ + package BarBaz; + use Mouse; + + { 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/008_replacing_super_methods.t b/t/600_todo_tests/008_replacing_super_methods.t new file mode 100644 index 0000000..83d5dfa --- /dev/null +++ b/t/600_todo_tests/008_replacing_super_methods.t @@ -0,0 +1,46 @@ +#!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use strict; +use warnings; +use Test::More; + +my ($super_called, $sub_called, $new_super_called) = (0, 0, 0); +{ + package Foo; + use Mouse; + + sub foo { $super_called++ } +} + +{ + package Foo::Sub; + use Mouse; + extends 'Foo'; + + override foo => sub { + $sub_called++; + super(); + }; +} + +Foo::Sub->new->foo; +is($super_called, 1, "super called"); +is($new_super_called, 0, "new super not called"); +is($sub_called, 1, "sub called"); + +($super_called, $sub_called, $new_super_called) = (0, 0, 0); + +Foo->meta->add_method(foo => sub { + $new_super_called++; +}); + +Foo::Sub->new->foo; +{ local $TODO = "super doesn't get replaced"; +is($super_called, 0, "super not called"); +is($new_super_called, 1, "new super called"); +} +is($sub_called, 1, "sub called"); + +done_testing; diff --git a/t/lib/Bar.pm b/t/lib/Bar.pm index c9d0ab0..8025d68 100644 --- a/t/lib/Bar.pm +++ b/t/lib/Bar.pm @@ -1,4 +1,7 @@ +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; package Bar; use Mouse; use Mouse::Util::TypeConstraints; diff --git a/t/lib/Bar7/Meta/Trait.pm b/t/lib/Bar7/Meta/Trait.pm new file mode 100644 index 0000000..4c246ab --- /dev/null +++ b/t/lib/Bar7/Meta/Trait.pm @@ -0,0 +1,11 @@ +package Bar7::Meta::Trait; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use Mouse::Role; + +around _immutable_options => sub { }; + +no Mouse::Role; + +1; diff --git a/t/lib/Bar7/Meta/Trait2.pm b/t/lib/Bar7/Meta/Trait2.pm new file mode 100644 index 0000000..554302e --- /dev/null +++ b/t/lib/Bar7/Meta/Trait2.pm @@ -0,0 +1,16 @@ +package Bar7::Meta::Trait2; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use Mouse::Role; + +has foo => ( + traits => ['Array'], + handles => { + push_foo => 'push', + }, +); + +no Mouse::Role; + +1; diff --git a/t/lib/Foo.pm b/t/lib/Foo.pm index 6cbac0f..b7750b2 100644 --- a/t/lib/Foo.pm +++ b/t/lib/Foo.pm @@ -1,4 +1,7 @@ +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; package Foo; use Mouse; diff --git a/t/lib/Moose/Meta/Attribute/Custom/Bar.pm b/t/lib/Moose/Meta/Attribute/Custom/Bar.pm new file mode 100644 index 0000000..f0c39c3 --- /dev/null +++ b/t/lib/Moose/Meta/Attribute/Custom/Bar.pm @@ -0,0 +1,13 @@ +package Mouse::Meta::Attribute::Custom::Bar; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +sub register_implementation { 'My::Bar' } + + +package My::Bar; + +use Mouse::Role; + +1; diff --git a/t/lib/Moose/Meta/Attribute/Custom/Foo.pm b/t/lib/Moose/Meta/Attribute/Custom/Foo.pm new file mode 100644 index 0000000..a602d90 --- /dev/null +++ b/t/lib/Moose/Meta/Attribute/Custom/Foo.pm @@ -0,0 +1,8 @@ +package Mouse::Meta::Attribute::Custom::Foo; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use Mouse::Role; + +1; diff --git a/t/lib/Moose/Meta/Attribute/Custom/Trait/Bar.pm b/t/lib/Moose/Meta/Attribute/Custom/Trait/Bar.pm new file mode 100644 index 0000000..7ee2b71 --- /dev/null +++ b/t/lib/Moose/Meta/Attribute/Custom/Trait/Bar.pm @@ -0,0 +1,13 @@ +package Mouse::Meta::Attribute::Custom::Trait::Bar; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +sub register_implementation { 'My::Trait::Bar' } + + +package My::Trait::Bar; + +use Mouse::Role; + +1; diff --git a/t/lib/Moose/Meta/Attribute/Custom/Trait/Foo.pm b/t/lib/Moose/Meta/Attribute/Custom/Trait/Foo.pm new file mode 100644 index 0000000..76b2d9d --- /dev/null +++ b/t/lib/Moose/Meta/Attribute/Custom/Trait/Foo.pm @@ -0,0 +1,8 @@ +package Mouse::Meta::Attribute::Custom::Trait::Foo; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use Mouse::Role; + +1; diff --git a/t/lib/MyExporter.pm b/t/lib/MyExporter.pm new file mode 100644 index 0000000..c7b8373 --- /dev/null +++ b/t/lib/MyExporter.pm @@ -0,0 +1,27 @@ + +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +package MyExporter; +use Mouse::Exporter; +use Test::More; + +Mouse::Exporter->setup_import_methods( + with_meta => [qw(with_prototype)], + as_is => [qw(as_is_prototype)], +); + +sub with_prototype (&) { + my ($class, $code) = @_; + isa_ok($code, 'CODE', 'with_prototype received a coderef'); + $code->(); +} + +sub as_is_prototype (&) { + my ($code) = @_; + isa_ok($code, 'CODE', 'as_is_prototype received a coderef'); + $code->(); +} + +1; diff --git a/t/lib/MyMetaclassRole.pm b/t/lib/MyMetaclassRole.pm index 19df7ec..7996337 100644 --- a/t/lib/MyMetaclassRole.pm +++ b/t/lib/MyMetaclassRole.pm @@ -1,4 +1,7 @@ package MyMetaclassRole; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use Mouse::Role; 1; diff --git a/t/lib/MyMooseA.pm b/t/lib/MyMooseA.pm new file mode 100644 index 0000000..4002f13 --- /dev/null +++ b/t/lib/MyMooseA.pm @@ -0,0 +1,10 @@ +package MyMooseA; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use Mouse; + +has 'b' => (is => 'rw', isa => 'MyMooseB'); + +1; \ No newline at end of file diff --git a/t/lib/MyMooseB.pm b/t/lib/MyMooseB.pm new file mode 100644 index 0000000..5680f7f --- /dev/null +++ b/t/lib/MyMooseB.pm @@ -0,0 +1,8 @@ +package MyMooseB; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use Mouse; + +1; \ No newline at end of file diff --git a/t/lib/MyMooseObject.pm b/t/lib/MyMooseObject.pm new file mode 100644 index 0000000..420037f --- /dev/null +++ b/t/lib/MyMooseObject.pm @@ -0,0 +1,10 @@ +package MyMooseObject; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; +use base 'Mouse::Object'; + +1; \ No newline at end of file diff --git a/t/lib/Role/Child.pm b/t/lib/Role/Child.pm index 1ee02b1..d3702bc 100644 --- a/t/lib/Role/Child.pm +++ b/t/lib/Role/Child.pm @@ -1,4 +1,7 @@ package Role::Child; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use Mouse::Role; with 'Role::Parent' => { -alias => { meth1 => 'aliased_meth1', } }; diff --git a/t/lib/Role/Interface.pm b/t/lib/Role/Interface.pm index f081f32..2c0badf 100644 --- a/t/lib/Role/Interface.pm +++ b/t/lib/Role/Interface.pm @@ -1,4 +1,7 @@ package Role::Interface; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use Mouse::Role; requires "meth2"; diff --git a/t/lib/Role/Parent.pm b/t/lib/Role/Parent.pm index 04befab..ac1e959 100644 --- a/t/lib/Role/Parent.pm +++ b/t/lib/Role/Parent.pm @@ -1,4 +1,7 @@ package Role::Parent; +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; use Mouse::Role; sub meth2 { }