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 {
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;
--- /dev/null
+#!/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;
#!/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';
# 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);
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;
#!/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;
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;
{
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()';
}
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;
#!/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
# -------------------------------------------------------------------
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');
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'),
+ );
}
{
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
# -------------------------------------------------------------------
my $k = Bar->new(foo => "Foo");
lives_ok { $k->foo_baz } "but not for class name";
}
+
+done_testing;
#!/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
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",
);
} "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" }
}
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" );
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;
#!/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)
dies_ok { make_class('ro', 'accessor', "Test::Class::AccessorRO"); } "Cant define attr with ro + accessor";
+done_testing;
#!/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/;
} 'has 0; works now';
}
+done_testing;
#!/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;
}
{
- package MouseX::SomeAwesomeDBFields;
+ package MooseX::SomeAwesomeDBFields;
# implementation of methods not called in the example deliberately
# omitted
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 {
lives_ok { __PACKAGE__->meta->make_immutable; }
"Inling constructor does not use inline_slot_access";
+
+ done_testing;
}
--- /dev/null
+#!/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;
#!/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;
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');
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';
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');
[ $foo_role->get_method_modifier_list('before') ],
[ 'boo' ],
'... got the right list of before method modifiers');
+
+done_testing;
#!/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' );
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 ...
#!/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
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;
#!/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
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');
with 'Bar2::Role';
} 'required method exists in superclass as non-modifier, so we live';
}
+
+done_testing;
#!/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;
}
+done_testing;
#!/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;
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;
#!/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;
}
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;
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';
}
{
{
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' },
}
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;
for qw( x1 foo_x1 );
ok( ! $baz->has_method('y1'), 'Role::Baz has no y1 method' );
}
+
+done_testing;
#!/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
} "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;
#!/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;
{
);
lives_ok {
- Mouse::Meta::Role::Application::RoleSummation->new->apply($c);
+ Mouse::Meta::Role::Application->new->apply($c);
} '... this composed okay';
##... now nest 'em
);
}
}
+
+done_testing;
#!/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;
{
# 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,
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';
}
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');
# 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,
# 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,
);
} '... this fails as expected';
-
+done_testing;
#!/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;
{
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(
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(
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(
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(
);
}
-
+done_testing;
#!/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;
{
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(
# 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,
# 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,
# 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,
);
} '... this fails as expected';
+done_testing;
#!/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;
{
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(
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(
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(
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(
);
}
+done_testing;
#!/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;
{
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(
# 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,
# 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,
# 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,
# 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,
)
);
} '... this fails as expected';
+
+done_testing;
#!/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;
{
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(
'... got the right list of methods'
);
}
+
+done_testing;
#!/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};
{
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;
--- /dev/null
+#!/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;
#!/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;
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);
is_deeply($aliases->get_method_exclusions, []);
is_deeply($overrides->get_method_exclusions, []);
+done_testing;
#!/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 {
is(My::Class->bar, 'My::Usual::Role', 'collateral role');
is_deeply($OPTS, { number => 1 });
+done_testing;
--- /dev/null
+#!/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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
#!/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;
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');
# 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' );
ok( ! $subtype->check('Foo'), '... this is not a Natural');
}
+done_testing;
#!/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 {
CodeRef
RegexpRef
Object
+ Role
)) {
is(find_type_constraint($type_name)->name,
$type_name,
# TODO:
# add tests for is_subtype_of which confirm the hierarchy
+
+done_testing;
#!/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');
}
{
=> 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');
{
}
}
-=cut
-
subtype 'StrWithTrailingX'
=> as 'Str'
=> where { /X$/ };
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;
#!/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 {
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');
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" );
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 {}');
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;
#!/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);
# 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);
is_deeply([ sort @{$foo->bar} ], [ 1, 2, 3 ], '... our coercion worked!');
-
+done_testing;
#!/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;
# 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');
# 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');
# 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');
# 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');
# 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(
# 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(
[[[ 1, 2, 3 ]], [[ qw/foo bar/ ]]]
), '... [[[ 1, 2, 3 ]], [[ qw/foo bar/ ]]] failed successfully');
-
-
+done_testing;
#!/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");
'... this correctly split the union (' . $_ . ')'
) for keys %split_tests;
}
+
+done_testing;
#!/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 {
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');
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');
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" );
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;
#!/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 {
ok(!$evenlist->check(MyList->new(10, "two")), '... validated it correctly (fail)');
ok(!$evenlist->check([10, 20]), '... validated it correctly (fail)');
+done_testing;
#!/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 {
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" );
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;
#!/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)');
{
- package Test::MouseX::Types::Maybe;
+ package Test::MooseX::Types::Maybe;
use Mouse;
has 'Maybe_Int' => (is=>'rw', isa=>'Maybe[Int]');
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]
throws_ok sub { $obj->Maybe_Int("a") },
qr/Attribute \(Maybe_Int\) does not pass the type constraint/
=> 'failed assigned ("a")';
+
+done_testing;
#!/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 {
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;
#!/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 {
is $union1->name, $union3->name, 'names match';
is $union2->name, $union3->name, 'names match';
+
+done_testing;
#!/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;
## Create a subclass with a custom method
{
- package Test::Mouse::Meta::TypeConstraint::AnySubType;
+ package Test::Mouse::Meta::TypeConstraint;
use Mouse;
extends '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';
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
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'));
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)
lives_ok {
Quux::Ier->new(age => (bless {}, 'Negative'))
};
+
+done_testing;
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;
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;
#!/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;
$t->walk;
is_deeply([splice @phonograph], ['footsteps']);
+done_testing;
#!/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;
not_enough_matches( [] )
} qr/No cases matched for /, '... not enough matches';
-
-
-
+done_testing;
#!/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
use strict;
use warnings;
- use base 'Class::MOP::Class';
+ use base 'Mouse::Meta::Class';
package Bar;
use strict;
qr/^Bar already has a metaclass, but it does not inherit Mouse::Meta::Class/,
'... got the right error too');
}
+
+done_testing;
#!/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;
package MyFramework;
use Mouse;
+ use Mouse::Deprecated -api_version => '0.55';
sub import {
my $CALLER = caller();
is($obj->foo, 10, '... got the right value');
-
-
-
+done_testing;
#!/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;
{
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;
{
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;
#!/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;
}
{
- 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'),
}
{
- 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'),
}
{
- 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'),
}
{
- 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'),
}
{
- 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'),
}
{
- 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'),
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'),
}
{
- 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'),
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} );
}
{
- 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'),
}
{
- 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'),
}
{
- 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'),
{
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'),
}
{
- 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'),
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} );
{
- 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'),
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()' );
}
{
}
{
- 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'),
{
package My::Class5;
use Mouse;
-
+
extends 'My::Class';
}
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'),
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';
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'] },
);
}
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';
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';
# 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
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'] },
);
}
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'] },
);
}
{
package My::Constructor;
- use base 'Mouse::Meta::Method::Constructor';
+ use base 'Mouse::Meta::Method';
}
{
__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'] },
);
}
}
{
- 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';
{
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;
sub bla {}
}
+
{
package My::Class12;
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' ),
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'] },
);
}
'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;
#!/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;
}
{
- 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'),
ok( $supers{$parent}, $desc );
}
+
+done_testing;
#!/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;
{
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 (
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'] },
);
}
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'] },
);
}
::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'] },
);
}
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;
#!/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
use strict;
use warnings;
-use Test::More tests => 15;
+use Test::More;
+$TODO = q{Mouse is not yet completed};
use Test::Exception;
{
die $@ if $@;
} 'failed to use trait without required attr';
+done_testing;
#!/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;
is(My::Class->meta->meta->name, 'My::Meta::Class');
is(My::Class::Aliased->meta->meta->name, 'My::Meta::Class');
+done_testing;
#!/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);
{
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'],
);
}
}
{
- 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 {
{
package Foo2;
- Foo::Exporter::WithMouse->import;
+ Foo::Exporter::WithMoose->import;
has(foo => (is => 'ro'));
}
{
- 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 {
{
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;
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;
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'],
+ },
);
};
}
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';
+ };
}
{
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'],
+ },
);
}
}
);
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" );
#!/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;
}
{
- last; # skip
Mouse::Util::MetaRole::apply_metaclass_roles(
for_class => 'My::Class',
wrapped_method_metaclass_roles => ['Role::Foo'],
}
{
- last; # skip
-
Mouse::Util::MetaRole::apply_metaclass_roles(
for_class => 'My::Class',
instance_metaclass_roles => ['Role::Foo'],
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'),
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} );
}
{
- last; # skip
-
Mouse::Util::MetaRole::apply_metaclass_roles(
for_class => 'My::Role',
application_to_class_class_roles => ['Role::Foo'],
}
{
- last; # skip
-
Mouse::Util::MetaRole::apply_metaclass_roles(
for_class => 'My::Role',
application_to_role_class_roles => ['Role::Foo'],
}
{
- last; # skip
-
Mouse::Util::MetaRole::apply_metaclass_roles(
for_class => 'My::Role',
application_to_instance_class_roles => ['Role::Foo'],
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} );
{
package My::Class5;
use Mouse;
-
+
extends 'My::Class';
}
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',
# 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
{
package My::Constructor;
- use base 'Mouse::Meta::Method::Constructor';
+ use base 'Mouse::Meta::Method';
}
{
}
{
- package ExportsMouse;
+ package ExportsMoose;
Mouse::Exporter->setup_import_methods(
also => 'Mouse',
}
lives_ok {
- package UsesExportedMouse;
- ExportsMouse->import;
+ package UsesExportedMoose;
+ ExportsMoose->import;
} 'import module which loads a role from disk during init_meta';
{
'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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
#!/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;
{
is($blart->a, 'Foo::a', '... got the right delgated value');
-
+done_testing;
#!/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;
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');
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');
ok( MyClass->meta->meta->does_role('MyRole'), 'metaclass does MyRole' );
is( MyClass->meta->foo, 'i am foo', '... foo method returns expected value' );
+done_testing;
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;
{
# 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;
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;
undef $method_meta;
}
+
+done_testing;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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 C<unpack>ish 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)
+
+
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
#!/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;
{
);
}
- # 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'
# AUTHOR: Aran Clary Deltac <bluefeet@cpan.org>
+done_testing;
#!/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;
local $TODO = $import eq 'blessed' ? "no automatic namespace cleaning yet" : undef;
ok(!Foo->can($import), "no namespace pollution in Mouse::Object ($import)" );
}
+
+done_testing;
+++ /dev/null
-#!/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';
-}
-
#!/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;
}
+done_testing;
#!/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;
}
+done_testing;
#!/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};
{
=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;
#!/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
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;
#!/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 ...
{
::like($warn, qr/Argument \"hello\" isn\'t numeric in addition \(\+\)/, '.. and it is the right warning');
}
}
+
+done_testing;
#!/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;
{
}
}
+done_testing;
#!/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(
override
augment
super inner
+ blessed confess
);
{
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;
#!/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;
}
+done_testing;
#!/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;
$bar->foo(Foo->new);
} '... checked the type constraint correctly';
-
-
+done_testing;
#!/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;
{
);
} 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(
# XXX: Continuing::To::Fail gets created anyway
+done_testing;
#!/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;
#!/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;
}
}
-
+done_testing;
--- /dev/null
+#!/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;
#!/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
throws_ok { Foo->does() } qr/^\QYou must supply a role name to does()/,
'Cannot call does() without a role name';
+
+done_testing;
#!/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;
is( $t2_am->name(), 'Test2',
'associated_metaclass->name is Test2' );
+
+done_testing;
#!/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;
is_deeply(\@demolished, ['Foo::Sub::Sub', 'Foo::Sub', 'Foo'],
"Foo::Sub::Sub demolished properly");
@demolished = ();
+
+done_testing;
#!/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;
my $self = shift;
my ($igd) = @_;
- print $igd || 0, "\n";
+ print $igd;
}
}
my $self = shift;
my ($igd) = @_;
- print $igd || 0, "\n";
+ print $igd;
}
__PACKAGE__->meta->make_immutable;
#!/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;
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;
--- /dev/null
+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;
#!/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;
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" );
#!/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;
ok(isweak($foo->{foo_weak}), '... it is a weak reference');
}
-
-
+done_testing;
#!/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;
is_deeply( \%hash, { foo => 1, bar => 2 }, "list context");
}
-
-
+done_testing;
#!/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 Scalar::Util 'isweak';
use Test::More;
+$TODO = q{Mouse is not yet completed};
use Test::Exception;
$attr->set_value( $foo, 3 );
- note 'skip Moose specific features';
- last;
-
is_deeply(
\@Foo::calls,
[ [ $foo, 3, 2 ] ],
}
{
- note 'skip Moose specific features';
- last;
-
my $foo = Foo->new(foo => 2);
is_deeply(
\@Foo::calls,
#!/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;
Foo->new;
} qr/^Attribute \(bar\) is required/, '... must supply all the required attribute';
+done_testing;
#!/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;
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;
isa_ok($bar_attr, 'Mouse::Meta::Attribute');
}
-
+done_testing;
#!/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;
Bar->new(baz => {})
} '... didnt create a new Bar with baz as a HASH ref';
-
+done_testing;
#!/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;
#!/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;
{
{
lives_ok {
$test->good_lazy_attr;
- } '... this does work';
+ } '... this does not work';
}
{
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";
}
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');
{
}
}
+
+done_testing;
#!/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;
is_deeply [ $autoderef->bar ], [ 1, 2, 3 ], '... auto-dereffed correctly';
}
+
+done_testing;
#!/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;
$r->headers;
} '... this coerces and passes the type constraint even with lazy';
-
-
+done_testing;
#!/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;
ok(!$gorch_attr->has_applied_traits, '... no traits applied');
is($gorch_attr->applied_traits, undef, '... no traits applied');
-
-
+done_testing;
#!/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;
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");
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;
#!/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;
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;
#!/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;
is( $foo->foo, "blah", "field is set via setter" );
}
+
+done_testing;
#!/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;
Fail::Bar->new(foo => 10)
} '... this fails, because initializer returns a bad type';
+done_testing;
#!/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;
isa_ok( $mtg->closing_date, 'Fake::DateTime' );
}
+done_testing;
#!/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;
#!/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;
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;
#!/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;
{
isa_ok($foo->bar->baz, 'Baz');
is($foo->bar->baz->hello, 'World', '... this all worked fine');
-
+done_testing;
#!/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;
$warn = '';
$meta->add_attribute('bar', is => 'bare');
is $warn, '', 'add attribute with no methods and is => "bare"';
+
+done_testing;
#!/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;
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;
#!/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 {
is_deeply [$o->h_ro], [], 'uninitialized HashRef attribute/ro in list context';
} 'testing';
+
+done_testing;
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;
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;
#!/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;
{
ok($foo->test, '... the test value has now been changed');
-
-
-
-
-
-
-
+done_testing;
--- /dev/null
+#!/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;
--- /dev/null
+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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
#!/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:
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');
'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
[ 'bling', 'fling' ],
'... got the right list of override method modifiers');
+done_testing;
#!/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;
#!/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;
#!/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
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');
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');
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;
#!/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;
#!/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);
}
{
- 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');
}
{
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');
}
{
- 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;
#!/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;
#!/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;
#!/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;
#!/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;
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 ...
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;
#!/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
}
}
+done_testing;
#!/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;
'Create a new class with several roles'
);
+done_testing;
#!/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;
{
is($x->gorch, 'BAR', '... got the right value');
}
-
+done_testing;
#!/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',
ok(!$role->is_anon_role, "the role is not anonymous");
+done_testing;
#!/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(
$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");
#!/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;
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;
#!/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 {
};
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;
#!/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;
is($@, '', "$get_func for no method mods does not die");
is(scalar(@mms),0,'is an empty list');
}
+
+done_testing;
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;
local $TODO = "the special () method isn't properly composed into the class";
is("$bar", 42, 'overloading can be composed');
}
+
+done_testing;
--- /dev/null
+# 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;
+++ /dev/null
-#!/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');
-
+++ /dev/null
-#!/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'/;
-
#!/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;
{
::ok( MyRef( {} ), '... Ref worked correctly' );
::ok( MyArrayRef( [] ), '... ArrayRef worked correctly' );
}
+
+done_testing;
#!/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;
-use t::lib::MooseCompat;
use Scalar::Util ();
BEGIN {
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');
#!/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; };
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;
#!/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;
Engine->new(header => \(my $var));
} '... dies correctly with bad params';
+done_testing;
#!/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 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;
# 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
sub as_string {
my ($self) = @_;
my $fh = $self->raw_body();
-
return do { local $/; <$fh> };
}
}
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;
#!/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);
# subtype with unions
{
- package Test::Mouse::Meta::TypeConstraint::Union;
+ package Test::Mouse::Meta::TypeConstraint;
use overload '""' => sub {'Broken|Test'}, fallback => 1;
use Mouse;
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';
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");
}
#!/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');
# 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');
# 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(
{
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;
#!/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');
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;
#!/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 {
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');
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');
ok(!$t->check(1), '... validated it correctly');
}
-
+done_testing;
#!/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 {
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]');
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'),
} '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;
#!/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;
{
qr/This number \(0\) is not less than ten!/,
'gave custom supertype error message on lazy set to 0';
+done_testing;
#!/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;
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');
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;
#!/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;
=> where { /^6$/ };
subtype 'TextSix' => as 'Str'
=> where { /Six/i };
-
coerce 'TextSix'
=> from 'DigitSix'
=> via { confess("Cannot live without 6 ($_)") unless /^6$/; 'Six' };
);
}
+my $attr = SomeClass->meta->get_attribute('foo');
+is($attr->get_value(SomeClass->new()), 'Six');
is(SomeClass->new()->foo, 'Six');
-
+done_testing;
#!/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 {
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 );
# 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
},
qr/Attribute \(from_parameterizable\) does not pass the type constraint/
=> 'from_parameterizable throws expected error';
+
+done_testing;
#!/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 {
subtype 'MySubType' => as 'Int' => where { 1 };
} qr/cannot be created again/, 'Trying to create same type twice throws';
+done_testing;
#!/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;
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;
--- /dev/null
+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;
#!/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;
{
# try with the other constraint form
lives_ok { DucktypeTest->new( other_swan => Swan->new ) } 'but a Swan can honk';
+
+done_testing;
+++ /dev/null
-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' );
#!/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;
isa_ok($c->meta->get_attribute('bling_bling'), 'My::Custom::Meta::Attr');
-
+done_testing;
#!/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';
use Mouse;
extends 'Mouse::Meta::Attribute';
- with 'MouseX::Attribute::Test';
+ with 'MooseX::Attribute::Test';
} 'custom attribute metaclass extending role is okay';
+
+done_testing;
#!/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
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 ],
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)');
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;
+++ /dev/null
-#!/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');
#!/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;
}
{
- 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();
}
{
# 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 ();
{
package WantsSugar;
- MouseX::Sugar->import();
+ MooseX::Sugar->import();
sub foo { 1 }
::is( wrapped1(), 'WantsSugar called wrapped1',
'wrapped1 identifies the caller correctly' );
- MouseX::Sugar->unimport();
+ MooseX::Sugar->unimport();
}
{
}
{
- package MouseX::MoreSugar;
+ package MooseX::MoreSugar;
use Mouse ();
sub wrapped2 {
- my $caller = shift;
+ my $caller = shift->name;
return $caller . ' called wrapped2';
}
}
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 }
::is( as_is1(), 'as_is1',
'as_is1 works as expected' );
- MouseX::MoreSugar->unimport();
+ MooseX::MoreSugar->unimport();
}
{
}
{
- 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'
::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 ();
}
{
- package MouseX::NotExporter;
+ package MooseX::NotExporter;
use Mouse ();
}
{
- 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();
}
{
::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";
{
package AllOptions;
use Mouse ();
+ use Mouse::Deprecated -api_version => '0.88';
use Mouse::Exporter;
Mouse::Exporter->setup_import_methods(
ok( ! UseAllOptions->can($_), "UseAllOptions::$_ has been unimported" )
for qw( with_meta1 with_meta2 with_caller1 with_caller2 as_is1 );
}
+
+done_testing;
#!/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;
{
'... and error provides a useful explanation' );
}
-
{
package Foo::Subclass;
is( $instance->an_attr, 'value', 'Can get value' );
}
'Can create instance and access attributes';
+
+done_testing;
#!/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',
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;
#!/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;
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;
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;
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;
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' );
my $subclass_meta = find_meta('SubClassUseBase');
ok does_role($subclass_meta, 'My::Role'),
'SubClass metaclass does role from parent metaclass';
+
+done_testing;
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;
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;
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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+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;
--- /dev/null
+#!/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;
#!/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
{ package Object::Test; }
-package Foo;
-::use_ok('Mouse');
+{
+ package Foo;
+ ::use_ok('Mouse');
+}
+
+done_testing;
#!/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;
#!/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;
#!/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
my $bar = Bar->new;
isa_ok($bar, 'Bar');
isa_ok($bar, 'Foo');
+
+done_testing;
#!/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
} '... this didnt die';
}
+done_testing;
#!/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;
is($foo->$reader, 10, "Reader works as expected");
}
-
-
-
+done_testing;
#!/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;
{
'Foo::foo(Baz::foo and Foo::foo())',
'... got the right value for 1 augmented subclass calling non-augmented subclass');
+done_testing;
#!/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;
{
$foo->bar();
is($Foo::bar_default_called, 1, "bar default was only called once when lazy attribute is accessed");
+
+done_testing;
#!/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;
}
}
-1;
-
+done_testing;
#!/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;
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;
-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:
#### 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' );
## This test fails at the time of creation.
ok ( !defined(Foo->new->foo(undef)), 'LazyBuild: Undef explicit' );
+
+done_testing;
--- /dev/null
+#!/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;
#!/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;
} qr/You cannot inherit from a Mouse Role \(My\:\:Role\)/,
'... this croaks correctly';
}
+
+done_testing;
#!/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
{
qr/Attribute \(nt\) does not pass the type constraint because: blessed/,
'... got the right error message';
+done_testing;
#!/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{
my $obj = Test::Mouse::Go::Boom5->new;
::is( $obj->id, '0 but true', 'value is still the same' );
}
+
+done_testing;
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;
is( C->new->foo, 'c' );
is( C->new->bar, 'cb' );
is( C->new->baz, 'cba' );
+
+done_testing;
--- /dev/null
+## 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;
-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;
package main;
+use Test::More;
+
{
local $TODO = 'Role composition does not clone methods yet';
is(MyClass1->foo, 'MyClass1::foo',
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;
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;
{
my $foo = Foo->new;
::isa_ok $foo, 'Bar';
}
+
+done_testing;
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;
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 {
}
'Class is created successfully';
}
+
+done_testing;
#!/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;
ok(Foo->new()->bug(), 'call constructor on object reference with overloading');
+done_testing;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+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;
#!/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
{
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;
--- /dev/null
+#!/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;
#!/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 {
is($coll2->print, '1, 4, 9, 16, 25, 36, 49, 64, 81, 100', '... new collection is changed');
}
-
-
-
-
-
-
-
+done_testing;
#!/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;
=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;
$foo->baz({});
} '... validation failed correctly';
+done_testing;
#!/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;
=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;
$foo->bar([{ foo => 3 }]);
} '... validation failed correctly';
-
+done_testing;
+++ /dev/null
-#!/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
- . ')' );
#!/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
'... parent2 and orphan child have the same last name ('
. $parent2->last_name
. ')' );
+
+done_testing;
#!/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;
is($rsi->first_name, 'Jim', '... got the right first name');
is($rsi->last_name, 'Johnson', '... got the right last name');
-
-
-
-
-
-
-
-
-
-
+done_testing;
#!/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;
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" );
"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";
}
Nothing here yet, but soon :)
=cut
+
+done_testing;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
#!/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
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
Foo->meta->make_immutable(debug => 0) unless $is_immutable;
}
-
-
+done_testing;
#!/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;
is( Foo->meta->get_method('DESTROY')->package_name, 'Foo',
'Foo has a DESTROY method in the Bar class (not inherited)' );
+
+done_testing;
#!/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;
-plan tests => 3;
{
package AClass;
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);
lives_ok { AClass->new(bar => 'bar') } '... no triggers called';
-
-
+done_testing;
#!/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
'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;
#!/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 ) = @_;
use Mouse;
extends qw(Foo);
-
+
__PACKAGE__->meta->make_immutable;
}
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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+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;
--- /dev/null
+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;
+++ /dev/null
-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';
-
--- /dev/null
+#!/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;
#!/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');
{
package Quux;
- #use metaclass;
+ use metaclass;
}
{
#ok(does_role('Foo::Foo', 'Foo'), '... Foo::Foo does do Foo');
+done_testing;
--- /dev/null
+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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
+# 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;
--- /dev/null
+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;
--- /dev/null
+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;
+# 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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+
+# 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;
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;
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
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', } };
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";
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 { }
projects / gitmo/Mouse.git / commitdiff