It doesn not affect public APIs, but internals are radically
changed. For users, using Mouse without roles should consume
less memory.
- * Moose compatibility tests are now generated from the Moose
- distribution. Currently 68% of these test files succeed,
- although some tests (e.g. related to metaclass.pm) will never
- passed.
[BUG FIXES]
* Meta class reinitialization caused by Mouse::Util::MetaRole
+++ /dev/null
-Notes for tests
-
-Moose compatibility tests are automatically generated from the
-Moose distribution, so you must not edit these tests. Instead
-add new tests to t/001_mouse/ or tests about bug reports to
-900/mouse_bugs/.
-
-test_status.log indicates the failing test status, and
-these failing tests are in t-failing/.
unless(defined $moose_dir and -d "$moose_dir/t") {
die "Usage: $0 Moose-dir [result-dir]\n";
}
-$result //= 't';
+$result //= 'Moose-t';
my @tests;
sub wanted {
+++ /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;
+++ /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;
+++ /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;
+++ /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;
+++ /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;
-
-use Mouse::Util::MetaRole;
-
-
-{
- package My::Meta::Class;
- use Mouse;
- extends 'Mouse::Meta::Class';
-}
-
-{
- package Role::Foo;
- use Mouse::Role;
- has 'foo' => ( is => 'ro', default => 10 );
-}
-
-{
- package My::Class;
-
- use Mouse;
-}
-
-{
- package My::Role;
- use Mouse::Role;
-}
-
-{
- Mouse::Util::MetaRole::apply_metaroles(
- for => My::Class->meta,
- class_metaroles => { class => ['Role::Foo'] },
- );
-
- ok( My::Class->meta()->meta()->does_role('Role::Foo'),
- 'apply Role::Foo to My::Class->meta()' );
- is( My::Class->meta()->foo(), 10,
- '... and call foo() on that meta object' );
-}
-
-{
- Mouse::Util::MetaRole::apply_metaroles(
- for => 'My::Class',
- class_metaroles => { attribute => ['Role::Foo'] },
- );
-
- ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
- q{apply Role::Foo to My::Class->meta()'s attribute metaclass} );
- ok( My::Class->meta()->meta()->does_role('Role::Foo'),
- '... My::Class->meta() still does Role::Foo' );
-
- My::Class->meta()->add_attribute( 'size', is => 'ro' );
- is( My::Class->meta()->get_attribute('size')->foo(), 10,
- '... call foo() on an attribute metaclass object' );
-}
-
-{
- Mouse::Util::MetaRole::apply_metaroles(
- for => 'My::Class',
- class_metaroles => { method => ['Role::Foo'] },
- );
-
- ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
- q{apply Role::Foo to My::Class->meta()'s method metaclass} );
- ok( My::Class->meta()->meta()->does_role('Role::Foo'),
- '... My::Class->meta() still does Role::Foo' );
- ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
- q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
-
- My::Class->meta()->add_method( 'bar' => sub { 'bar' } );
- is( My::Class->meta()->get_method('bar')->foo(), 10,
- '... call foo() on a method metaclass object' );
-}
-
-{
- 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'),
- q{apply Role::Foo to My::Class->meta()'s wrapped method metaclass} );
- ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
- '... My::Class->meta() still does Role::Foo' );
- ok( My::Class->meta()->meta()->does_role('Role::Foo'),
- '... My::Class->meta() still does Role::Foo' );
- ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
- q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
-
- My::Class->meta()->add_after_method_modifier( 'bar' => sub { 'bar' } );
- is( My::Class->meta()->get_method('bar')->foo(), 10,
- '... call foo() on a wrapped method metaclass object' );
-}
-
-{
- Mouse::Util::MetaRole::apply_metaroles(
- for => 'My::Class',
- class_metaroles => { instance => ['Role::Foo'] },
- );
-
- ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
- q{apply Role::Foo to My::Class->meta()'s instance metaclass} );
- ok( My::Class->meta()->meta()->does_role('Role::Foo'),
- '... My::Class->meta() still does Role::Foo' );
- ok( My::Class->meta()->attribute_metaclass()->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} );
-
- is( My::Class->meta()->get_meta_instance()->foo(), 10,
- '... call foo() on an instance metaclass object' );
-}
-
-{
- 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{apply Role::Foo to My::Class->meta()'s constructor class} );
- ok( My::Class->meta()->meta()->does_role('Role::Foo'),
- '... My::Class->meta() still does Role::Foo' );
- ok( My::Class->meta()->attribute_metaclass()->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} );
-
- # Actually instantiating the constructor class is too freaking hard!
- ok( My::Class->meta()->constructor_class()->can('foo'),
- '... constructor class has a foo method' );
-}
-
-{
- 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{apply Role::Foo to My::Class->meta()'s destructor class} );
- ok( My::Class->meta()->meta()->does_role('Role::Foo'),
- '... My::Class->meta() still does Role::Foo' );
- ok( My::Class->meta()->attribute_metaclass()->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()->constructor_class()->meta()->does_role('Role::Foo'),
- q{... My::Class->meta()'s constructor class still does Role::Foo} );
-
- # same problem as the constructor class
- ok( My::Class->meta()->destructor_class()->can('foo'),
- '... destructor class has a foo method' );
-}
-
-{
- 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'),
- q{apply Role::Foo to My::Role->meta's application_to_class class} );
-
- is( My::Role->meta->application_to_class_class->new->foo, 10,
- q{... call foo() on an application_to_class instance} );
-}
-
-{
- 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'),
- q{apply Role::Foo to My::Role->meta's application_to_role class} );
- ok( My::Role->meta->application_to_class_class->meta->does_role('Role::Foo'),
- q{... My::Role->meta's application_to_class class still does Role::Foo} );
-
- is( My::Role->meta->application_to_role_class->new->foo, 10,
- q{... call foo() on an application_to_role instance} );
-}
-
-{
- 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'),
- q{apply Role::Foo to My::Role->meta's application_to_instance class} );
- ok( My::Role->meta->application_to_role_class->meta->does_role('Role::Foo'),
- q{... My::Role->meta's application_to_role class still does Role::Foo} );
- ok( My::Role->meta->application_to_class_class->meta->does_role('Role::Foo'),
- q{... My::Role->meta's application_to_class class still does Role::Foo} );
-
- is( My::Role->meta->application_to_instance_class->new->foo, 10,
- q{... call foo() on an application_to_instance instance} );
-}
-
-{
- Mouse::Util::MetaRole::apply_base_class_roles(
- for => 'My::Class',
- roles => ['Role::Foo'],
- );
-
- ok( My::Class->meta()->does_role('Role::Foo'),
- 'apply Role::Foo to My::Class base class' );
- is( My::Class->new()->foo(), 10,
- '... call foo() on a My::Class object' );
-}
-
-{
- package My::Class2;
-
- use Mouse;
-}
-
-{
- 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'),
- 'apply Role::Foo to My::Class2->meta()' );
- is( My::Class2->meta()->foo(), 10,
- '... and call foo() on that meta object' );
- ok( My::Class2->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
- q{apply Role::Foo to My::Class2->meta()'s attribute metaclass} );
- My::Class2->meta()->add_attribute( 'size', is => 'ro' );
-
- is( My::Class2->meta()->get_attribute('size')->foo(), 10,
- '... call foo() on an attribute metaclass object' );
-
- ok( My::Class2->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
- q{apply Role::Foo to My::Class2->meta()'s method metaclass} );
-
- My::Class2->meta()->add_method( 'bar' => sub { 'bar' } );
- 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()->constructor_class()->meta()->does_role('Role::Foo'),
- q{apply Role::Foo to My::Class2->meta()'s constructor class} );
- ok( My::Class2->meta()->constructor_class()->can('foo'),
- '... constructor class has a foo method' );
-
- ok( My::Class2->meta()->destructor_class()->meta()->does_role('Role::Foo'),
- q{apply Role::Foo to My::Class2->meta()'s destructor class} );
- ok( My::Class2->meta()->destructor_class()->can('foo'),
- '... destructor class has a foo method' );
-}
-
-
-{
- package My::Meta;
-
- use Mouse::Exporter;
- Mouse::Exporter->setup_import_methods( also => 'Mouse' );
-
- sub init_meta {
- shift;
- my %p = @_;
-
- Mouse->init_meta( %p, metaclass => 'My::Meta::Class' );
- }
-}
-
-{
- package My::Class3;
-
- My::Meta->import();
-}
-
-
-{
- Mouse::Util::MetaRole::apply_metaroles(
- for => 'My::Class3',
- class_metaroles => { class => ['Role::Foo'] },
- );
-
- ok( My::Class3->meta()->meta()->does_role('Role::Foo'),
- 'apply Role::Foo to My::Class3->meta()' );
- 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_metaroles() does not interfere with metaclass set via Mouse->init_meta()' );
-}
-
-{
- package Role::Bar;
- use Mouse::Role;
- has 'bar' => ( is => 'ro', default => 200 );
-}
-
-{
- package My::Class4;
- use Mouse;
-}
-
-{
- 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_metaroles(
- for => 'My::Class4',
- class_metaroles => { class => ['Role::Bar'] },
- );
-
- ok( My::Class4->meta()->meta()->does_role('Role::Bar'),
- 'apply Role::Bar to My::Class4->meta()' );
- ok( My::Class4->meta()->meta()->does_role('Role::Foo'),
- '... and My::Class4->meta() still does Role::Foo' );
-}
-
-{
- package My::Class5;
- use Mouse;
-
- extends 'My::Class';
-}
-
-{
- ok( My::Class5->meta()->meta()->does_role('Role::Foo'),
- q{My::Class5->meta()'s does Role::Foo because it extends My::Class} );
- ok( My::Class5->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
- q{My::Class5->meta()'s attribute metaclass also does Role::Foo} );
- ok( My::Class5->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
- q{My::Class5->meta()'s method metaclass also does Role::Foo} );
- ok( My::Class5->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
- q{My::Class5->meta()'s instance metaclass also does Role::Foo} );
- ok( My::Class5->meta()->constructor_class()->meta()->does_role('Role::Foo'),
- q{My::Class5->meta()'s constructor class also does Role::Foo} );
- ok( My::Class5->meta()->destructor_class()->meta()->does_role('Role::Foo'),
- q{My::Class5->meta()'s destructor class also does Role::Foo} );
-}
-
-{
- Mouse::Util::MetaRole::apply_metaroles(
- for => 'My::Class5',
- class_metaroles => { class => ['Role::Bar'] },
- );
-
- ok( My::Class5->meta()->meta()->does_role('Role::Bar'),
- q{apply Role::Bar My::Class5->meta()} );
- ok( My::Class5->meta()->meta()->does_role('Role::Foo'),
- q{... and My::Class5->meta() still does Role::Foo} );
-}
-
-{
- package My::Class6;
- use Mouse;
-
- Mouse::Util::MetaRole::apply_metaroles(
- for => 'My::Class6',
- class_metaroles => { class => ['Role::Bar'] },
- );
-
- extends 'My::Class';
-}
-
-{
- ok( My::Class6->meta()->meta()->does_role('Role::Bar'),
- q{apply Role::Bar My::Class6->meta() before extends} );
- ok( My::Class6->meta()->meta()->does_role('Role::Foo'),
- q{... and My::Class6->meta() does Role::Foo because My::Class6 extends My::Class} );
-}
-
-# This is the hack that used to be needed to work around the
-# _fix_metaclass_incompatibility problem. You called extends() (which
-# in turn calls _fix_metaclass_imcompatibility) _before_ you apply
-# more extensions in the subclass. We wabt to make sure this continues
-# to work in the future.
-{
- package My::Class7;
- use Mouse;
-
- # In real usage this would go in a BEGIN block so it happened
- # before apply_metaroles was called by an extension.
- extends 'My::Class';
-
- Mouse::Util::MetaRole::apply_metaroles(
- for => 'My::Class7',
- class_metaroles => { class => ['Role::Bar'] },
- );
-}
-
-{
- ok( My::Class7->meta()->meta()->does_role('Role::Bar'),
- q{apply Role::Bar My::Class7->meta() before extends} );
- ok( My::Class7->meta()->meta()->does_role('Role::Foo'),
- q{... and My::Class7->meta() does Role::Foo because My::Class7 extends My::Class} );
-}
-
-{
- package My::Class8;
- use Mouse;
-
- Mouse::Util::MetaRole::apply_metaroles(
- for => 'My::Class8',
- class_metaroles => {
- class => ['Role::Bar'],
- attribute => ['Role::Bar'],
- },
- );
-
- extends 'My::Class';
-}
-
-{
- ok( My::Class8->meta()->meta()->does_role('Role::Bar'),
- q{apply Role::Bar My::Class8->meta() before extends} );
- ok( My::Class8->meta()->meta()->does_role('Role::Foo'),
- q{... and My::Class8->meta() does Role::Foo because My::Class8 extends My::Class} );
- ok( My::Class8->meta()->attribute_metaclass->meta()->does_role('Role::Bar'),
- q{apply Role::Bar to My::Class8->meta()->attribute_metaclass before extends} );
- ok( My::Class8->meta()->attribute_metaclass->meta()->does_role('Role::Foo'),
- q{... and My::Class8->meta()->attribute_metaclass does Role::Foo because My::Class8 extends My::Class} );
-}
-
-
-{
- package My::Class9;
- use Mouse;
-
- Mouse::Util::MetaRole::apply_metaroles(
- for => 'My::Class9',
- class_metaroles => { attribute => ['Role::Bar'] },
- );
-
- extends 'My::Class';
-}
-
-{
- ok( My::Class9->meta()->meta()->does_role('Role::Foo'),
- q{... and My::Class9->meta() does Role::Foo because My::Class9 extends My::Class} );
- ok( My::Class9->meta()->attribute_metaclass->meta()->does_role('Role::Bar'),
- q{apply Role::Bar to My::Class9->meta()->attribute_metaclass before extends} );
- ok( My::Class9->meta()->attribute_metaclass->meta()->does_role('Role::Foo'),
- q{... and My::Class9->meta()->attribute_metaclass does Role::Foo because My::Class9 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_ MooseX::ClassAttribute, so the metaclass
-# for Fey::Meta::Class::Table does a role.
-#
-# At one point this caused a metaclass incompatibility error down
-# below, when we applied roles to the metaclass of My::Class10. It's
-# all madness but as long as the tests pass we're happy.
-{
- package My::Meta::Class2;
- use Mouse;
- extends 'Mouse::Meta::Class';
-
- Mouse::Util::MetaRole::apply_metaroles(
- for => 'My::Meta::Class2',
- class_metaroles => { class => ['Role::Foo'] },
- );
-}
-
-{
- package My::Object;
- use Mouse;
- extends 'Mouse::Object';
-}
-
-{
- package My::Meta2;
-
- use Mouse::Exporter;
- Mouse::Exporter->setup_import_methods( also => 'Mouse' );
-
- sub init_meta {
- shift;
- my %p = @_;
-
- Mouse->init_meta(
- %p,
- metaclass => 'My::Meta::Class2',
- base_class => 'My::Object',
- );
- }
-}
-
-{
- package My::Class10;
- My::Meta2->import;
-
- Mouse::Util::MetaRole::apply_metaroles(
- for => 'My::Class10',
- class_metaroles => { class => ['Role::Bar'] },
- );
-}
-
-{
- ok( My::Class10->meta()->meta()->meta()->does_role('Role::Foo'),
- q{My::Class10->meta()->meta() does Role::Foo } );
- ok( My::Class10->meta()->meta()->does_role('Role::Bar'),
- q{My::Class10->meta()->meta() does Role::Bar } );
- ok( My::Class10->meta()->isa('My::Meta::Class2'),
- q{... and My::Class10->meta still isa(My::Meta::Class2)} );
- ok( My::Class10->isa('My::Object'),
- q{... and My::Class10 still isa(My::Object)} );
-}
-
-{
- package My::Constructor;
-
- use base 'Mouse::Meta::Method';
-}
-
-{
- package My::Class11;
-
- use Mouse;
-
- __PACKAGE__->meta->constructor_class('My::Constructor');
-
- Mouse::Util::MetaRole::apply_metaroles(
- for => 'My::Class11',
- class_metaroles => { class => ['Role::Foo'] },
- );
-}
-
-{
- ok( My::Class11->meta()->meta()->does_role('Role::Foo'),
- q{My::Class11->meta()->meta() does Role::Foo } );
- is( My::Class11->meta()->constructor_class, 'My::Constructor',
- q{... and explicitly set constructor_class value is unchanged)} );
-}
-
-{
- package ExportsMoose;
-
- Mouse::Exporter->setup_import_methods(
- also => 'Mouse',
- );
-
- sub init_meta {
- shift;
- my %p = @_;
- Mouse->init_meta(%p);
- 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.
- class_metaroles => { class => [qw/MyMetaclassRole/] },
- );
- }
-}
-
-lives_ok {
- package UsesExportedMoose;
- ExportsMoose->import;
-} 'import module which loads a role from disk during init_meta';
-
-{
- package Foo::Meta::Role;
-
- use Mouse::Role;
-}
-
-{
- package Foo::Role;
-
- Mouse::Exporter->setup_import_methods(
- also => 'Mouse::Role',
- );
-
- sub init_meta {
- shift;
- my %p = @_;
-
- Mouse::Role->init_meta(%p);
-
- return Mouse::Util::MetaRole::apply_metaroles(
- for => $p{for_class},
- role_metaroles => { method => ['Foo::Meta::Role'] },
- );
- }
-}
-
-{
- package Role::Baz;
-
- Foo::Role->import;
-
- sub bla {}
-}
-
-{
- package My::Class12;
-
- use Mouse;
-
- 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' ),
- 'method_metaclass_role applied'
- );
-}
-
-{
- package Parent;
- use Mouse;
-
- Mouse::Util::MetaRole::apply_metaroles(
- for => __PACKAGE__,
- class_metaroles => { constructor => ['Role::Foo'] },
- );
-}
-
-{
- package Child;
-
- use Mouse;
- extends 'Parent';
-}
-
-{
- ok(
- Parent->meta->constructor_class->meta->can('does_role')
- && Parent->meta->constructor_class->meta->does_role('Role::Foo'),
- 'Parent 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;
+++ /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 is automatically generated by author/import-moose-test.pl.
-# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
-use t::lib::MooseCompat;
+
+# This test is taken from Moose :)
use strict;
use warnings;
-use Test::More;
+use Test::More tests => 10;
{
);
}
- use List::MoreUtils qw( zip );
+ # use List::MoreUtils 'zip'
+ # code taken from List::MoreUtils
+ sub zip (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) {
+ my $max = -1;
+ $max < $#$_ && ( $max = $#$_ ) for @_;
+
+ map { my $ix = $_; map $_->[$ix], @_; } 0 .. $max;
+ }
+
coerce 'Human::EyeColor'
=> from 'ArrayRef'
# AUTHOR: Aran Clary Deltac <bluefeet@cpan.org>
-done_testing;
#!/usr/bin/perl
+
use strict;
use warnings;
-use Test::More;
+use Test::More 'no_plan';
use Test::Exception;
-my $warn = '';
-BEGIN { $SIG{__WARN__} = sub { $warn .= "@_" } }
+
{
package Foo;
use Mouse;
my $g = Gorch->new;
is( $g->foo, "the default", "inherited attribute" );
- is( $g->oink, "oink", "inherited method from a non-Mouse class");
}
-is $warn, '', 'produces no warnings';
-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::More tests => 29;
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;
+use Test::More tests => 16;
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;
+use Test::More tests => 16;
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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 5;
+
{
=cut
-is($baz->bar,
- 'Bar::bar -> Foo::bar(Baz::bar)',
- '... got the right value from mixed augment/override bar');
-
-done_testing;
+{
+ 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');
+}
#!/usr/bin/perl
-# This is automatically generated by author/import-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::More tests => 15;
+
=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');
-
-done_testing;
+is($foo->baz(), 'Foo::baz', '... got the right value from &baz');
\ No newline at end of file
#!/usr/bin/perl
-# This 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;
+use Test::More tests => 15;
# 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;
+use Test::More tests => 7;
+
{
}
}
-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::More tests => 40;
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;
-}
+ok(!Bar->can($_), '... Bar can no longer do ' . $_) for @moose_type_constraint_exports;
-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;
+use Test::More tests => 9;
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;
+use Test::More tests => 7;
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;
+use Test::More tests => 7;
use Test::Exception;
{
);
} qr/You must pass an ARRAY ref of roles/;
-ok !Made::Of::Fail->isa('UNIVERSAL'), "did not create Made::Of::Fail";
+ok !Mouse::Util::is_class_loaded('Made::Of::Fail'), "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;
+use Test::More tests => 14;
{
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;
+use Test::More tests => 3;
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;
+use Test::More tests => 6;
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;
+use Test::More tests => 3;
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;
+ print $igd || 0, "\n";
}
}
my $self = shift;
my ($igd) = @_;
- print $igd;
+ print $igd || 0, "\n";
}
__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;
}
-ok(
- $_,
- 'in_global_destruction state is passed to DEMOLISH properly (true)'
-) for split //, `$^X t/010_basics/020-global-destruction-helper.pl`;
+$? = 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';
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::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::More tests => 11;
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' with value 10\.5/,
+qr/^Attribute \(type_constrained\) does not pass the type constraint because\: Validation failed for 'Int' failed 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' with value 5\.5/,
+qr/^Attribute \(type_constrained\) does not pass the type constraint because\: Validation failed for 'Int' failed 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' with value 10\.5/,
+qr/^Attribute \(type_constrained\) does not pass the type constraint because\: Validation failed for 'Int' failed 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;
-$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;
+use Test::More tests => 29;
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;
+use Test::More tests => 57;
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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 9;
use Test::Exception;
+
{
package Foo::Role;
use Mouse::Role;
has 'bar' => (is => 'rw', does => 'Bar::Role');
has 'baz' => (
is => 'rw',
- does => role_type('Bar::Role')
+ does => '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', does => 'Foo::Role');
+ has 'foo' => (is => 'rw', isa => 'Foo::Class');
+
+ package Foo::Class;
+ use Mouse;
+
+ with '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' => (isa => 'Foo::Class', does => 'Bar::Class');
+ has 'foo' => (is => 'rw', 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' => (isa => 'Bling', does => 'Bar::Class');
+ has 'foo' => (is => 'rw', 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;
+use Test::More tests => 15;
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;
+use Test::More tests => 16;
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->name, 'Object', '... got the right type constraint parent name');
+
+ is($foo_attr_type_constraint->parent, 'Object', '... got the right type constraint parent name');
}
{
package Bar::Meta::Attribute;
use Mouse;
- extends 'Mouse::Meta::Attribute';
+ #extends 'Class::MOP::Attribute';
+ extends 'Foo::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;
+use Test::More tests => 18;
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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 39;
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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 43;
use Test::Exception;
+use lib 't/lib';
+use Test::Mouse;
{
{
lives_ok {
$test->good_lazy_attr;
- } '... this does not work';
+ } '... this does 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");
- throws_ok { $instance->fool }
- qr/Test::LazyBuild::Attribute does not support builder method \'_build_fool\' for attribute \'fool\'/,
+ dies_ok { $instance->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;
}
-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';
+# 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';
-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;
+use Test::More tests => 11;
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;
+use Test::More tests => 2;
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 Test::More;
+use lib 't/lib';
+
+use Test::More tests => 12;
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 Test::More;
-$TODO = q{Mouse is not yet completed};
+use lib 't/lib';
+
+use Test::More tests => 23;
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 Test::More;
+use lib 't/lib';
+
+use Test::More tests => 7;
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;
+use Test::More tests => 4;
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;
+use Test::More tests => 11;
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;
+use Test::More tests => 5;
{
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;
+use Test::More tests => 4;
use Test::Exception;
{
isa_ok($foo->bar->baz, 'Baz');
is($foo->bar->baz->hello, 'World', '... this all worked fine');
-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;
-
+BEGIN{ $ENV{MOUSE_VERBOSE} = 1 }
use strict;
use warnings;
-use Test::More;
+use Test::More tests => 2;
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/perl
-# This is automatically generated by author/import-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::More tests => 14;
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;
-use Test::Mouse;
+use Test::More tests => 12;
{
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',
- writer => 'set_at_type',
- default => 'at type',
+ default => 2,
);
has 'has spaces' => (
- isa => 'Int',
required => 0,
reader => 'get_hs',
default => 42,
);
- has '!req' => (
- required => 1,
- reader => 'req'
- );
-
no Mouse;
}
-with_immutable {
+{
+ my $foo = Foo->new;
+
ok( Foo->meta->has_attribute($_), "Foo has '$_' attribute" )
for 'type', '@type', 'has spaces';
- 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} );
+ 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} );
- $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->meta->make_immutable, redo if Foo->meta->is_mutable;
}
-'Foo';
-
-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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 92;
use Test::Exception;
+
# -------------------------------------------------------------------
# HASH handles
# -------------------------------------------------------------------
isa_ok($bar->foo, 'Foo');
my $meth = Bar->meta->get_method('foo_bar');
-isa_ok($meth, 'Mouse::Meta::Method');
+isa_ok($meth, 'Mouse::Meta::Method::Delegation');
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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 23;
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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 17;
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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 8;
use Test::Exception;
my $exception_regex = qr/You must provide a name for the attribute/;
} 'has 0; works now';
}
-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;
-use Test::Requires {
- 'Test::Output' => '0.01', # skip all if not installed
-};
+BEGIN {
+ eval "use Test::Output;";
+ plan skip_all => "Test::Output is required for this test" if $@;
+ plan tests => 5;
+}
{
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;
}
{
- package MooseX::SomeAwesomeDBFields;
+ package MouseX::SomeAwesomeDBFields;
# implementation of methods not called in the example deliberately
# omitted
use Mouse;
use Mouse::Util::MetaRole;
- use Test::More;
-$TODO = q{Mouse is not yet completed};
+ use Test::More tests => 3;
use Test::Exception;
- Mouse::Util::MetaRole::apply_metaroles(
- for => __PACKAGE__,
- class_metaroles => { instance => ['MooseX::SomeAwesomeDBFields'] },
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => __PACKAGE__,
+ instance_metaclass_roles => ['MouseX::SomeAwesomeDBFields']
);
lives_ok {
lives_ok { __PACKAGE__->meta->make_immutable; }
"Inling constructor does not use inline_slot_access";
-
- 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::More tests => 5;
use Test::Exception;
{
ok($foo->test, '... the test value has now been 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;
-use Test::More;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 26;
use Test::Exception;
+use Test::Mouse;
use Mouse::Meta::Role;
-use Mouse::Util::TypeConstraints ();
+use lib 't/lib';
+use MooseCompat;
{
package FooRole;
my $foo_role = Mouse::Meta::Role->initialize('FooRole');
isa_ok($foo_role, 'Mouse::Meta::Role');
-isa_ok($foo_role, 'Mouse::Meta::Module');
+#isa_ok($foo_role, 'Class::MOP::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');
-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'
-);
-
+{
+ 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');
+}
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');
-my $baz = $foo_role->get_attribute('baz');
-is_deeply( $baz->original_options, { is => 'ro' },
- 'original options for baz attribute' );
+is_deeply(
+ $foo_role->get_attribute('baz')->{is},
+ 'ro',
+ '... got the correct description of the 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::More tests => 40;
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, 'Mouse::Meta::Module');
+#isa_ok($foo_role, 'Class::MOP::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');
-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');
+{
+ 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');
+}
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');
-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');
+
+{
+ 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');
+}
# 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;
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';
-
- ::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';
+ with 'FooRole';
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;
#!/usr/bin/perl
-# This is automatically generated 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;
+use Test::More tests => 32;
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');
-isa_ok(My::Test::Class2->meta->get_method('foo'), 'Mouse::Meta::Method');
+{
+local $TODO = 'Not a Mouse::Meta::Method::Overriden';
+isa_ok(My::Test::Class2->meta->get_method('foo'), 'Mouse::Meta::Method::Overridden');
+}
ok(My::Test::Class2::Base->meta->has_method('foo'), '... have the method foo as expected');
-isa_ok(My::Test::Class2::Base->meta->get_method('foo'), 'Mouse::Meta::Method');
-
+{
+local $TODO = 'Not a Class::MOP::Method';
+isa_ok(My::Test::Class2::Base->meta->get_method('foo'), 'Class::MOP::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');
-isa_ok(My::Test::Class3->meta->get_method('foo'), 'Mouse::Meta::Method');
+{
+local $TODO = 'Not a Class::MOP::Method::Wrapped';
+isa_ok(My::Test::Class3->meta->get_method('foo'), 'Class::MOP::Method::Wrapped');
+}
ok(My::Test::Class3::Base->meta->has_method('foo'), '... have the method foo as expected');
-isa_ok(My::Test::Class3::Base->meta->get_method('foo'), 'Mouse::Meta::Method');
-
+{
+local $TODO = 'Not a Class::MOP::Method';
+isa_ok(My::Test::Class3::Base->meta->get_method('foo'), 'Class::MOP::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('Sleeper'), '... we do not do any roles yet');
+ ok(!$obj2->does('Bark'), '... we do not do any roles yet');
- Sleeper->meta->apply($obj2);
+ Bark->meta->apply($obj2);
- 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($obj2->does('Bark'), '... we now do the Bark role');
+ is(blessed($obj), blessed($obj2), '... they 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 still don\'t share the same anon-class/role thing');
+ isnt(blessed($obj), blessed($obj2), '... they no longer share the same anon-class/role thing');
isa_ok($obj, 'My::Class');
}
{
- ok(!$obj2->does('Bark'), '... we do not do Bark yet');
-
- Bark->meta->apply($obj2);
+ ok(!$obj2->does('Sleeper'), '... we do not do any roles yet');
- 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');
-}
+ Sleeper->meta->apply($obj2);
-# 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');
+ ok($obj2->does('Sleeper'), '... we now do the Bark role');
+ is(blessed($obj), blessed($obj2), '... they share the same anon-class/role thing again');
}
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::More tests => 46;
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;
- ::throws_ok {
+ ::dies_ok {
with 'Foo::Role' => { -alias => { 'foo' => 'foo_foo' }, -excludes => 'foo' },
'Bar::Role' => { -alias => { 'foo' => 'foo_foo' }, -excludes => 'foo' },
'Baz::Role';
- } 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';
+ } '... 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;
#!/usr/bin/perl
-# This is automatically generated 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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 27;
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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 21;
use Test::Exception;
+
{
package Foo;
use Mouse;
is($foo->bar, 'BAR', '... got the expect value');
ok($foo->can('baz'), '... we have baz method now');
- is($foo->baz, 'FOO-BAZ', '... got the expect value');
+ {
+ local $TODO = 'rebless_params is not implemented';
+ 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';
- is($foo->bar, 'FOO-BAR', '... got the expect value');
+ {
+ local $TODO = 'rebless params is not implemented';
+ is($foo->bar, 'FOO-BAR', '... got the expect value');
+ }
ok($foo->can('baz'), '... we have baz method now');
- is($foo->baz, 'FOO-BAZ', '... got the expect value');
+ {
+ local $TODO = 'rebless params is not implemented';
+ 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 $@;
-use Test::Requires {
- 'Test::Output' => '0.01', # skip all if not installed
-};
+ plan tests => 8;
+}
# 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;
+use Test::More tests => 1;
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;
+use Test::More tests => 17;
+use lib 't/lib';
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;
-use Mouse ();
+use Test::More tests => 4;
+use Mouse::Role ();
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/^Mouse::Meta::Role::__ANON__::SERIAL::\d+$/, "");
+like($role->name, qr/::__ANON__::/, "");
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;
-use Mouse ();
+use Test::More tests => 4;
+use Mouse::Role ();
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;
+use Test::More tests => 2;
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;
+use Test::More tests => 6;
# 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;
+use Test::More tests => 1;
{
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;
#!/usr/bin/perl
-# This is automatically generated by author/import-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::More tests => 22;
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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 15;
use Test::Exception;
=pod
sub foo { 'Class::ProvideFoo::foo' }
before 'foo' => sub { 'Class::ProvideFoo::foo:before' };
- ::isa_ok(__PACKAGE__->meta->get_method('foo'), 'Mouse::Meta::Method');
+ ::isa_ok(__PACKAGE__->meta->get_method('foo'), 'Class::MOP::Method::Wrapped');
::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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 39;
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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 19;
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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 14;
use Test::Exception;
-use Mouse::Meta::Role::Application;
+#use Mouse::Meta::Role::Application::RoleSummation;
use Mouse::Meta::Role::Composite;
{
);
lives_ok {
- Mouse::Meta::Role::Application->new->apply($c);
+ Mouse::Meta::Role::Application::RoleSummation->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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 12;
use Test::Exception;
-use Mouse::Meta::Role::Application;
+#use Mouse::Meta::Role::Application::RoleSummation;
use Mouse::Meta::Role::Composite;
{
# test simple exclusion
dies_ok {
- Mouse::Meta::Role::Application->new->apply(
+ Mouse::Meta::Role::Application::RoleSummation->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->new->apply($c);
+ Mouse::Meta::Role::Application::RoleSummation->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->new->apply($c);
+ Mouse::Meta::Role::Application::RoleSummation->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->new->apply(
+ Mouse::Meta::Role::Application::RoleSummation->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->new->apply(
+ Mouse::Meta::Role::Application::RoleSummation->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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 16;
use Test::Exception;
-use Mouse::Meta::Role::Application;
+use Mouse::Meta::Role::Application::RoleSummation;
use Mouse::Meta::Role::Composite;
{
is($c->name, 'Role::Foo|Role::Bar', '... got the composite role name');
lives_ok {
- Mouse::Meta::Role::Application->new->apply($c);
+ Mouse::Meta::Role::Application::RoleSummation->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->new->apply($c);
+ Mouse::Meta::Role::Application::RoleSummation->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->new->apply($c);
+ Mouse::Meta::Role::Application::RoleSummation->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->new->apply($c);
+ Mouse::Meta::Role::Application::RoleSummation->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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 7;
use Test::Exception;
-use Mouse::Meta::Role::Application;
+use Mouse::Meta::Role::Application::RoleSummation;
use Mouse::Meta::Role::Composite;
{
is($c->name, 'Role::Foo|Role::Bar', '... got the composite role name');
lives_ok {
- Mouse::Meta::Role::Application->new->apply($c);
+ Mouse::Meta::Role::Application::RoleSummation->new->apply($c);
} '... this succeeds as expected';
is_deeply(
# test simple conflict
dies_ok {
- Mouse::Meta::Role::Application->new->apply(
+ Mouse::Meta::Role::Application::RoleSummation->new->apply(
Mouse::Meta::Role::Composite->new(
roles => [
Role::Foo->meta,
# test complex conflict
dies_ok {
- Mouse::Meta::Role::Application->new->apply(
+ Mouse::Meta::Role::Application::RoleSummation->new->apply(
Mouse::Meta::Role::Composite->new(
roles => [
Role::Foo->meta,
# test simple conflict
dies_ok {
- Mouse::Meta::Role::Application->new->apply(
+ Mouse::Meta::Role::Application::RoleSummation->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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 19;
use Test::Exception;
-use Mouse::Meta::Role::Application;
+use Mouse::Meta::Role::Application::RoleSummation;
use Mouse::Meta::Role::Composite;
{
is($c->name, 'Role::Foo|Role::Bar', '... got the composite role name');
lives_ok {
- Mouse::Meta::Role::Application->new->apply($c);
+ Mouse::Meta::Role::Application::RoleSummation->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->new->apply($c);
+ Mouse::Meta::Role::Application::RoleSummation->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->new->apply($c);
+ Mouse::Meta::Role::Application::RoleSummation->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->new->apply($c);
+ Mouse::Meta::Role::Application::RoleSummation->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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 8;
use Test::Exception;
-use Mouse::Meta::Role::Application;
+use Mouse::Meta::Role::Application::RoleSummation;
use Mouse::Meta::Role::Composite;
{
is($c->name, 'Role::Foo|Role::Bar', '... got the composite role name');
lives_ok {
- Mouse::Meta::Role::Application->new->apply($c);
+ Mouse::Meta::Role::Application::RoleSummation->new->apply($c);
} '... this lives ok';
is_deeply(
# test simple overrides w/ conflicts
dies_ok {
- Mouse::Meta::Role::Application->new->apply(
+ Mouse::Meta::Role::Application::RoleSummation->new->apply(
Mouse::Meta::Role::Composite->new(
roles => [
Role::Foo->meta,
# test simple overrides w/ conflicts
dies_ok {
- Mouse::Meta::Role::Application->new->apply(
+ Mouse::Meta::Role::Application::RoleSummation->new->apply(
Mouse::Meta::Role::Composite->new(
roles => [
Role::Foo->meta,
# test simple overrides w/ conflicts
dies_ok {
- Mouse::Meta::Role::Application->new->apply(
+ Mouse::Meta::Role::Application::RoleSummation->new->apply(
Mouse::Meta::Role::Composite->new(
roles => [
Role::Foo->meta,
# test simple overrides w/ conflicts
dies_ok {
- Mouse::Meta::Role::Application->new->apply(
+ Mouse::Meta::Role::Application::RoleSummation->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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 7;
use Test::Exception;
-use Mouse::Meta::Role::Application;
+use Mouse::Meta::Role::Application::RoleSummation;
use Mouse::Meta::Role::Composite;
{
is($c->name, 'Role::Foo|Role::Bar', '... got the composite role name');
lives_ok {
- Mouse::Meta::Role::Application->new->apply($c);
+ Mouse::Meta::Role::Application::RoleSummation->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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 17;
{
isnt( ClassA->foo, "ClassB::foo", "ClassA::foo is not confused with ClassB::foo");
-is( ClassB->foo, 'Role::Foo::foo', 'ClassB::foo knows its name' );
-is( ClassA->foo, 'Role::Foo::foo', 'ClassA::foo knows its name' );
-
-done_testing;
+{
+ 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' );
+}
--- /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');
+
#!/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::More tests => 24;
do {
package Role::Foo;
my $aliases = $aliases[0];
my $overrides = $overrides[0];
-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');
+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');
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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 3;
my $OPTS;
do {
is(My::Class->bar, 'My::Usual::Role', 'collateral role');
is_deeply($OPTS, { number => 1 });
-done_testing;
--- /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;
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 Test::More;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 17;
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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 8; # tests => 26;
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;
+use Test::More tests => 25;
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;
-use Test::Requires {
- 'IO::String' => '0.01', # skip all if not installed
- 'IO::File' => '0.01',
-};
+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;
+}
+
+
{
package Email::Mouse;
# create the alias
- subtype 'IO::StringOrFile' => as 'IO::String | IO::File';
+ my $st = subtype 'IO::StringOrFile' => as 'IO::String | IO::File';
+ #::diag $st->dump;
# 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;
+ package Test::Mouse::Meta::TypeConstraint::Union;
use overload '""' => sub {'Broken|Test'}, fallback => 1;
use Mouse;
extends 'Mouse::Meta::TypeConstraint';
}
-my $dummy_instance = Test::Mouse::Meta::TypeConstraint->new;
+my $dummy_instance = Test::Mouse::Meta::TypeConstraint::Union->new;
ok $dummy_instance => "Created Instance";
isa_ok $dummy_instance,
- 'Test::Mouse::Meta::TypeConstraint' => 'isa correct type';
+ 'Test::Mouse::Meta::TypeConstraint::Union' => '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->equals($bar), "Foo type is not equal to Bar type");
- ok( $foo->equals($foo), "Foo equals Foo");
+ 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( 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;
-$TODO = q{Mouse is not yet completed};
-use Test::Exception;
+use Test::More 'no_plan';
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;
+use Test::More tests => 19;
use Test::Exception;
BEGIN {
is($t->name, 'MyCollections', '... name is correct');
my $p = $t->parent;
- isa_ok($p, 'Mouse::Meta::TypeConstraint');
+# isa_ok($p, 'Mouse::Meta::TypeConstraint::Union');
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');
+# isa_ok($p, 'Mouse::Meta::TypeConstraint::Union');
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;
+use Test::More tests => 9;
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;
+use Test::More tests => 54;
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 an Int');
+ok(!Int(undef), '... undef is NOT a 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 an Int');
+ok(Int(5), '... 5 is a 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 an Int');
+ok(!Int(0.5), '... 0.5 is NOT a 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 an Int');
+ok(!Int('Foo'), '... "Foo" is NOT a 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;
+use Test::More tests => 1;
{
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;
+use Test::More tests => 2;
use Test::Exception;
BEGIN {
subtype 'MySubType' => as 'Int' => where { 1 };
} qr/cannot be created again/, 'Trying to create same type twice throws';
-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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 85;
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' with value -5",
+ "Validation failed for 'Natural' failed 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;
+use Test::More tests => 4;
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 lib 't/lib', 'lib';
-use Test::More;
+use Test::More tests => 4;
use Test::Exception;
+
$SIG{__WARN__} = sub { 0 };
eval { require Foo; };
delete $INC{'Bar.pm'};
eval { require Bar; };
-ok(!$@, '... re-loaded Bar successfully') || diag $@;
-
-done_testing;
+ok(!$@, '... re-loaded Bar successfully') || diag $@;
\ No newline at end of file
#!/usr/bin/perl
-# This is automatically generated by author/import-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::More tests => 35;
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->new(type_constraints => [$Str, $Undef]);
-isa_ok($Str_or_Undef, 'Mouse::Meta::TypeConstraint');
+my $Str_or_Undef = Mouse::Meta::TypeConstraint::Union->new(type_constraints => [$Str, $Undef]);
+isa_ok($Str_or_Undef, 'Mouse::Meta::TypeConstraint::Union');
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->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->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->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->new(type_constraints => [$ArrayRef, $HashRef]);
-isa_ok($HashOrArray, 'Mouse::Meta::TypeConstraint');
+my $HashOrArray = Mouse::Meta::TypeConstraint::Union->new(type_constraints => [$ArrayRef, $HashRef]);
+isa_ok($HashOrArray, 'Mouse::Meta::TypeConstraint::Union');
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\' with value SCALAR\(0x.+?\) and Validation failed for \'HashRef\' with value SCALAR\(0x.+?\) in \(ArrayRef\|HashRef\)/,
+qr/Validation failed for \'ArrayRef\' failed with value SCALAR\(0x.+?\) and Validation failed for \'HashRef\' failed with value SCALAR\(0x.+?\) in \(ArrayRef\|HashRef\)/,
'... (ArrayRef | HashRef) cannot accept scalar refs');
like($HashOrArray->validate(sub {}),
-qr/Validation failed for \'ArrayRef\' with value CODE\(0x.+?\) and Validation failed for \'HashRef\' with value CODE\(0x.+?\) in \(ArrayRef\|HashRef\)/,
+qr/Validation failed for \'ArrayRef\' failed with value CODE\(0x.+?\) and Validation failed for \'HashRef\' failed with value CODE\(0x.+?\) in \(ArrayRef\|HashRef\)/,
'... (ArrayRef | HashRef) cannot accept code refs');
is($HashOrArray->validate(50),
-'Validation failed for \'ArrayRef\' with value 50 and Validation failed for \'HashRef\' with value 50 in (ArrayRef|HashRef)',
+'Validation failed for \'ArrayRef\' failed with value 50 and Validation failed for \'HashRef\' failed 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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 24;
use Test::Exception;
BEGIN {
use_ok('Mouse::Util::TypeConstraints');
- use_ok('Mouse::Meta::TypeConstraint');
+ use_ok('Mouse::Meta::TypeConstraint::Parameterized');
}
# Array of Ints
-my $array_of_ints = Mouse::Meta::TypeConstraint->new(
+my $array_of_ints = Mouse::Meta::TypeConstraint::Parameterized->new(
name => 'ArrayRef[Int]',
parent => find_type_constraint('ArrayRef'),
type_parameter => find_type_constraint('Int'),
);
-isa_ok($array_of_ints, 'Mouse::Meta::TypeConstraint');
+isa_ok($array_of_ints, 'Mouse::Meta::TypeConstraint::Parameterized');
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->new(
+my $hash_of_ints = Mouse::Meta::TypeConstraint::Parameterized->new(
name => 'HashRef[Int]',
parent => find_type_constraint('HashRef'),
type_parameter => find_type_constraint('Int'),
);
-isa_ok($hash_of_ints, 'Mouse::Meta::TypeConstraint');
+isa_ok($hash_of_ints, 'Mouse::Meta::TypeConstraint::Parameterized');
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->new(
+my $array_of_array_of_ints = Mouse::Meta::TypeConstraint::Parameterized->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');
+isa_ok($array_of_array_of_ints, 'Mouse::Meta::TypeConstraint::Parameterized');
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' );
+ isa_ok( $anon_type, 'Mouse::Meta::TypeConstraint::Parameterized' );
my $param_type = $anon_type->type_parameter;
- isa_ok( $param_type, 'Mouse::Meta::TypeConstraint' );
+ isa_ok( $param_type, 'Mouse::Meta::TypeConstraint::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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 9;
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->new(
+my $array_of_ints = Mouse::Meta::TypeConstraint::Parameterized->new(
name => 'ArrayRef[Int]',
parent => find_type_constraint('ArrayRef'),
type_parameter => find_type_constraint('Int'),
);
-isa_ok($array_of_ints, 'Mouse::Meta::TypeConstraint');
+isa_ok($array_of_ints, 'Mouse::Meta::TypeConstraint::Parameterized');
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->new(
+my $hash_of_ints = Mouse::Meta::TypeConstraint::Parameterized->new(
name => 'HashRef[Int]',
parent => find_type_constraint('HashRef'),
type_parameter => find_type_constraint('Int'),
);
-isa_ok($hash_of_ints, 'Mouse::Meta::TypeConstraint');
+isa_ok($hash_of_ints, 'Mouse::Meta::TypeConstraint::Parameterized');
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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 33;
use Test::Exception;
BEGIN {
use_ok('Mouse::Util::TypeConstraints');
- use_ok('Mouse::Meta::TypeConstraint');
+ use_ok('Mouse::Meta::TypeConstraint::Parameterized');
}
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');
+isa_ok($array_of_ints_or_strings, 'Mouse::Meta::TypeConstraint::Parameterized');
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');
+isa_ok($array_of_ints_or_hash_ref, 'Mouse::Meta::TypeConstraint::Parameterized');
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');
+isa_ok($pure_insanity, 'Mouse::Meta::TypeConstraint::Union');
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');
+isa_ok($array_of_ints, 'Mouse::Meta::TypeConstraint::Parameterized');
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');
+isa_ok($array_of_array_of_ints, 'Mouse::Meta::TypeConstraint::Parameterized');
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');
+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');
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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 41;
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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 39;
use Test::Exception;
BEGIN {
is($t->name, 'MySpecialHash', '... name is correct');
my $p = $t->parent;
- isa_ok($p, 'Mouse::Meta::TypeConstraint');
+ isa_ok($p, 'Mouse::Meta::TypeConstraint::Parameterized');
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');
+ isa_ok($p, 'Mouse::Meta::TypeConstraint::Parameterized');
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');
+ isa_ok($t, 'Mouse::Meta::TypeConstraint::Parameterizable');
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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 28;
use Test::Exception;
BEGIN {
use_ok("Mouse::Util::TypeConstraints");
- use_ok('Mouse::Meta::TypeConstraint');
+ use_ok('Mouse::Meta::TypeConstraint::Parameterized');
}
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->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" );
+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" );
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->new(
+ Mouse::Meta::TypeConstraint::Parameterized->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->new(
+ Mouse::Meta::TypeConstraint::Parameterized->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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 11;
use Test::Exception;
BEGIN {
use_ok("Mouse::Util::TypeConstraints");
- use_ok('Mouse::Meta::TypeConstraint');
+ use_ok('Mouse::Meta::TypeConstraint::Parameterized');
}
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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 20;
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->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');
-}
+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" );
-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::More tests => 36;
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');
+isa_ok($type, 'Mouse::Meta::TypeConstraint::Parameterized');
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->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::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::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::MooseX::Types::Maybe;
+ package Test::MouseX::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::MooseX::Types::Maybe->new
+ok my $obj = Test::MouseX::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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 18;
use Test::Exception;
BEGIN {
ok( $type->equals($type), "equals self" );
-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" );
+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" );
-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::More tests => 37;
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;
+use Test::More tests => 12;
use Test::Exception;
BEGIN {
my $from_parameterizable = $parameterizable->parameterize($int);
isa_ok $parameterizable,
- 'Mouse::Meta::TypeConstraint', =>
+ 'Mouse::Meta::TypeConstraint::Parameterizable', =>
'Got expected type instance';
- package Test::Mouse::Meta::TypeConstraint;
+ package Test::Mouse::Meta::TypeConstraint::Parameterizable;
use Mouse;
has parameterizable => ( is => 'rw', isa => $parameterizable );
# Create and check a dummy object
-ok my $params = Test::Mouse::Meta::TypeConstraint->new() =>
+ok my $params = Test::Mouse::Meta::TypeConstraint::Parameterizable->new() =>
'Create Dummy object for testing';
-isa_ok $params, 'Test::Mouse::Meta::TypeConstraint' =>
+isa_ok $params, 'Test::Mouse::Meta::TypeConstraint::Parameterizable' =>
'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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 26;
use Test::Exception;
use Mouse::Util::TypeConstraints;
## Create a subclass with a custom method
{
- package Test::Mouse::Meta::TypeConstraint;
+ package Test::Mouse::Meta::TypeConstraint::AnySubType;
use Mouse;
extends 'Mouse::Meta::TypeConstraint';
}
my $Int = find_type_constraint('Int');
-ok $Int, 'Got a good type constraint';
+ok $Int, 'Got a good type contstraint';
-my $parent = Test::Mouse::Meta::TypeConstraint->new({
- name => "Test::Mouse::Meta::TypeConstraint" ,
- parent => $Int,
+my $parent = Test::Mouse::Meta::TypeConstraint::AnySubType->new({
+ name => "Test::Mouse::Meta::TypeConstraint::AnySubType" ,
+ 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' with value Baz=HASH\(0x\w+\) \(not isa Foo\)/, 'Better validation message';
+like $foo->get_message( Baz->new ), qr/^Validation failed for 'Foo' failed 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' 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' failed 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' with value 3 \(not isa Positive\)/;
+} qr/^Attribute \(age\) does not pass the type constraint because: Validation failed for 'Positive' failed 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' with value 3 \(not isa Positive\)/;
+} qr/^Attribute \(age\) does not pass the type constraint because: Validation failed for 'Positive' failed with value 3 \(not isa Positive\)/;
lives_ok {
Quux->new(age => Positive->new)
lives_ok {
Quux::Ier->new(age => (bless {}, 'Negative'))
};
-
-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::More tests => 4;
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',
+isa_ok( $type->parent, 'Mouse::Meta::TypeConstraint::Class',
'parent type constraint is a class type' );
-
-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' );
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::More tests => 6;
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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 5;
use Test::Exception;
{
# try with the other constraint form
lives_ok { DucktypeTest->new( other_swan => Swan->new ) } 'but a Swan can honk';
-
-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::More tests => 2;
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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 25;
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;
+use Test::More tests => 3;
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;
+use Test::More tests => 2;
use Test::Exception;
+;
+
lives_ok {
- package MooseX::Attribute::Test;
+ package MouseX::Attribute::Test;
use Mouse::Role;
} 'creating custom attribute "metarole" is okay';
use Mouse;
extends 'Mouse::Meta::Attribute';
- with 'MooseX::Attribute::Test';
+ with 'MouseX::Attribute::Test';
} 'custom attribute metaclass extending role is okay';
-
-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 lib 't/lib', 'lib';
-use Test::More;
+use Test::More tests => 32;
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;
+use Test::More tests => 4;
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;
+
+use Test::More tests => 5;
{
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 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;
#!/usr/bin/perl
-# This is automatically generated by author/import-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::More tests => 4;
use Test::Exception;
+
=pod
This test demonstrates that Mouse will respect
use strict;
use warnings;
- use base 'Mouse::Meta::Class';
+ use base 'Class::MOP::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;
+use Test::More tests => 16;
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, 'Mouse::Meta::Class');
+isa_ok($anon, 'Class::MOP::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, 'Mouse::Meta::Attribute');
+ isa_ok($attr, 'Class::MOP::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, 'Mouse::Meta::Attribute');
+ isa_ok($attr, 'Class::MOP::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;
#!/usr/bin/perl
-# This is automatically generated by author/import-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::More tests => 7;
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;
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 MooseX::Empty;
+ package MouseX::Empty;
use Mouse ();
Mouse::Exporter->setup_import_methods( also => 'Mouse' );
}
{
- package WantsMoose;
+ package WantsMouse;
- MooseX::Empty->import();
+ MouseX::Empty->import();
sub foo { 1 }
- ::can_ok( 'WantsMoose', 'has' );
- ::can_ok( 'WantsMoose', 'with' );
- ::can_ok( 'WantsMoose', 'foo' );
+ ::can_ok( 'WantsMouse', 'has' );
+ ::can_ok( 'WantsMouse', 'with' );
+ ::can_ok( 'WantsMouse', 'foo' );
- MooseX::Empty->unimport();
+ MouseX::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( ! WantsMoose->can('has'), 'WantsMoose::has() has been cleaned' );
- ok( ! WantsMoose->can('with'), 'WantsMoose::with() has been cleaned' );
- can_ok( 'WantsMoose', 'foo' );
+ ok( ! WantsMouse->can('has'), 'WantsMouse::has() has been cleaned' );
+ ok( ! WantsMouse->can('with'), 'WantsMouse::with() has been cleaned' );
+ can_ok( 'WantsMouse', 'foo' );
# This makes sure that Mouse->init_meta() happens properly
- isa_ok( WantsMoose->meta(), 'Mouse::Meta::Class' );
- isa_ok( WantsMoose->new(), 'Mouse::Object' );
+ isa_ok( WantsMouse->meta(), 'Mouse::Meta::Class' );
+ isa_ok( WantsMouse->new(), 'Mouse::Object' );
}
{
- package MooseX::Sugar;
+ package MouseX::Sugar;
use Mouse ();
{
package WantsSugar;
- MooseX::Sugar->import();
+ MouseX::Sugar->import();
sub foo { 1 }
::is( wrapped1(), 'WantsSugar called wrapped1',
'wrapped1 identifies the caller correctly' );
- MooseX::Sugar->unimport();
+ MouseX::Sugar->unimport();
}
{
}
{
- package MooseX::MoreSugar;
+ package MouseX::MoreSugar;
use Mouse ();
sub wrapped2 {
- my $caller = shift->name;
+ my $caller = shift;
return $caller . ' called wrapped2';
}
}
Mouse::Exporter->setup_import_methods(
- with_meta => ['wrapped2'],
- as_is => ['as_is1'],
- also => 'MooseX::Sugar',
+ with_caller => ['wrapped2'],
+ as_is => ['as_is1'],
+ also => 'MouseX::Sugar',
);
}
{
package WantsMoreSugar;
- MooseX::MoreSugar->import();
+ MouseX::MoreSugar->import();
sub foo { 1 }
::is( as_is1(), 'as_is1',
'as_is1 works as expected' );
- MooseX::MoreSugar->unimport();
+ MouseX::MoreSugar->unimport();
}
{
}
{
- package MooseX::CircularAlso;
+ package MouseX::CircularAlso;
use Mouse ();
::dies_ok(
sub {
Mouse::Exporter->setup_import_methods(
- also => [ 'Mouse', 'MooseX::CircularAlso' ],
+ also => [ 'Mouse', 'MouseX::CircularAlso' ],
);
},
'a circular reference in also dies with an error'
::like(
$@,
- qr/\QCircular reference in 'also' parameter to Mouse::Exporter between MooseX::CircularAlso and MooseX::CircularAlso/,
+ qr/\QCircular reference in 'also' parameter to Mouse::Exporter between MouseX::CircularAlso and MouseX::CircularAlso/,
'got the expected error from circular reference in also'
);
}
{
- package MooseX::NoAlso;
+ package MouseX::NoAlso;
use Mouse ();
}
{
- package MooseX::NotExporter;
+ package MouseX::NotExporter;
use Mouse ();
}
{
- package MooseX::OverridingSugar;
+ package MouseX::OverridingSugar;
use Mouse ();
sub has {
- my $caller = shift->name;
+ my $caller = shift;
return $caller . ' called has';
}
Mouse::Exporter->setup_import_methods(
- with_meta => ['has'],
- also => 'Mouse',
+ with_caller => ['has'],
+ also => 'Mouse',
);
}
{
package WantsOverridingSugar;
- MooseX::OverridingSugar->import();
+ MouseX::OverridingSugar->import();
::can_ok( 'WantsOverridingSugar', 'has' );
::can_ok( 'WantsOverridingSugar', 'with' );
::is( has('foo'), 'WantsOverridingSugar called has',
- 'has from MooseX::OverridingSugar is called, not has from Mouse' );
+ 'has from MouseX::OverridingSugar is called, not has from Mouse' );
- MooseX::OverridingSugar->unimport();
+ MouseX::OverridingSugar->unimport();
}
{
::stderr_like {
Mouse::Exporter->setup_import_methods(
also => ['Mouse'],
- with_meta => ['does_not_exist'],
+ with_caller => ['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 Test::More;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 8;
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 MooseAlike1;
+ package MouseAlike1;
use strict;
use warnings;
{
package Foo;
- MooseAlike1->import();
+ MouseAlike1->import();
::lives_ok( sub { has( 'size', is => 'bare' ) },
- 'has was exported via MooseAlike1' );
+ 'has was exported via MouseAlike1' );
- MooseAlike1->unimport();
+ MouseAlike1->unimport();
}
ok( ! Foo->can('has'),
- 'No has sub in Foo after MooseAlike1 is unimported' );
+ 'No has sub in Foo after MouseAlike1 is unimported' );
ok( Foo->can('meta'),
'Foo has a meta method' );
isa_ok( Foo->meta(), 'Mouse::Meta::Class' );
{
- package MooseAlike2;
+ package MouseAlike2;
use strict;
use warnings;
{
package Bar;
- MooseAlike2->import();
+ MouseAlike2->import();
::lives_ok( sub { has( 'size', is => 'bare' ) },
- 'has was exported via MooseAlike2' );
+ 'has was exported via MouseAlike2' );
- MooseAlike2->unimport();
+ MouseAlike2->unimport();
}
ok( ! Bar->can('has'),
- 'No has sub in Bar after MooseAlike2 is unimported' );
+ 'No has sub in Bar after MouseAlike2 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;
-
-# 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;
-$TODO = q{Mouse is not yet completed};
+use Test::More 'no_plan';
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_ MooseX::ClassAttribute, so the metaclass
+# itself, and then it _uses_ MouseX::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';
+ use base 'Mouse::Meta::Method::Constructor';
}
{
}
{
- package ExportsMoose;
+ package ExportsMouse;
Mouse::Exporter->setup_import_methods(
also => 'Mouse',
}
lives_ok {
- package UsesExportedMoose;
- ExportsMoose->import;
+ package UsesExportedMouse;
+ ExportsMouse->import;
} 'import module which loads a role from disk during init_meta';
{
'Parent 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'
- );
+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'
+ );
+ }
}
-
-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::More tests => 8;
use Mouse::Util::MetaRole;
}
{
- Mouse::Util::MetaRole::apply_metaroles(
- for => 'My::Class',
- class_metaroles => { class => ['Role::Foo'] },
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class',
+ metaclass_roles => ['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_metaroles works with metaclass.pm' );
+ 'apply_metaclass_roles works with metaclass.pm' );
}
{
- Mouse::Util::MetaRole::apply_metaroles(
- for => 'My::Class2',
- class_metaroles => {
- attribute => ['Role::Foo'],
- method => ['Role::Foo'],
- instance => ['Role::Foo'],
- },
+ 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'],
);
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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 24;
use Test::Exception;
{
has foo => ( 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::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" );
package Baz;
use metaclass (
use Mouse;
extends 'Baz';
- Mouse::Util::MetaRole::apply_metaroles(
- for => __PACKAGE__,
- class_metaroles => { class => ['Role::Foo'] },
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => __PACKAGE__,
+ metaclass_roles => ['Role::Foo'],
);
}
use Mouse;
- Mouse::Util::MetaRole::apply_metaroles(
- for => __PACKAGE__,
- class_metaroles => { class => ['Role::Foo'] },
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => __PACKAGE__,
+ metaclass_roles => ['Role::Foo'],
);
}
::lives_ok { extends 'Foo::Sub' } 'error_class differs by role so incompat is handled';
- Mouse::Util::MetaRole::apply_metaroles(
- for => __PACKAGE__,
- class_metaroles => { error => ['Role::Foo'] },
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => __PACKAGE__,
+ error_class_roles => ['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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 15;
use Test::Exception;
{
die $@ if $@;
} 'failed to use trait without required attr';
-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;
-$TODO = q{Mouse is not yet completed};
+use Test::More (tests => 4);
use Test::Exception;
lives_and {
with_prototype {
my $caller = caller(0);
- is($caller, 'MyExporter', "With_caller prototype code gets called from MyMooseX");
+ is($caller, 'MyExporter', "With_caller prototype code gets called from MyMouseX");
};
} "check function with prototype";
lives_and {
as_is_prototype {
my $caller = caller(0);
- is($caller, 'MyExporter', "As-is prototype code gets called from MyMooseX");
+ is($caller, 'MyExporter', "As-is prototype code gets called from MyMouseX");
};
} "check function with prototype";
-
-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 Test::More tests => 2;
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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 13;
use Test::Mouse qw(does_ok);
{
use Mouse::Exporter;
Mouse::Exporter->setup_import_methods(
- class_metaroles => {
- class => ['Foo::Trait::Class'],
- attribute => ['Foo::Trait::Attribute'],
- },
- role_metaroles => { role => ['Foo::Trait::Class'] },
- base_class_roles => ['Foo::Role::Base'],
+ metaclass_roles => ['Foo::Trait::Class'],
+ attribute_metaclass_roles => ['Foo::Trait::Attribute'],
+ base_class_roles => ['Foo::Role::Base'],
);
}
}
{
- package Foo::Exporter::WithMoose;
+ package Foo::Exporter::WithMouse;
use Mouse ();
use Mouse::Exporter;
- 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)],
+ 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)],
);
sub init_meta {
{
package Foo2;
- Foo::Exporter::WithMoose->import;
+ Foo::Exporter::WithMouse->import;
has(foo => (is => 'ro'));
}
{
- package Foo::Exporter::WithMooseRole;
+ package Foo::Exporter::WithMouseRole;
use Mouse::Role ();
use Mouse::Exporter;
- 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)],
+ 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)],
);
sub init_meta {
{
package Foo2::Role;
- Foo::Exporter::WithMooseRole->import;
+ Foo::Exporter::WithMouseRole->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_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'],
- },
+ 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'],
);
};
}
package Role::WithCustomApplication;
use Mouse::Role;
- around composition_class_roles => sub {
- my ($orig, $self) = @_;
- return $self->$orig, 'Role::Composite';
- };
+ has '+composition_class_roles' => (
+ default => ['Role::Composite'],
+ );
}
{
sub init_meta {
my ( $self, %options ) = @_;
- 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'],
- },
+ 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'],
);
}
}
);
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" );
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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 2;
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;
+++ /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;
+use Test::More tests => 1;
=pod
{ package Object::Test; }
-{
- package Foo;
- ::use_ok('Mouse');
-}
-
-done_testing;
+package Foo;
+::use_ok('Mouse');
#!/usr/bin/perl
-# This is automatically generated by 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::More tests => 2;
-use_ok('MyMooseA');
-use_ok('MyMooseB');
-done_testing;
+
+use_ok('MyMouseA');
+use_ok('MyMouseB');
\ No newline at end of file
#!/usr/bin/perl
-# This is automatically generated by 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::More tests => 1;
-use_ok('MyMooseObject');
-
-done_testing;
+use_ok('MyMouseObject');
\ No newline at end of file
#!/usr/bin/perl
-# This is automatically generated by author/import-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::More tests => 2;
+
+
=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;
+use Test::More tests => 1;
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;
+use Test::More tests => 3;
{
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;
+use Test::More tests => 3;
+
{
'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;
+use Test::More tests => 2;
+
{
$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;
+use Test::More tests => 144;
use Test::Exception;
use Mouse::Util::TypeConstraints;
}
}
-done_testing;
+1;
+
#!/usr/bin/perl
-# This is automatically generated 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', lazy_build => 1 );
-has 'bar' => ( isa => 'Int | Undef', is => 'rw' );
+has 'foo' => ( isa => 'Int | Undef', is => 'rw', coerce => 1, lazy_build => 1 );
+has 'bar' => ( isa => 'Int | Undef', is => 'rw', coerce => 1 );
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;
+use Test::More tests => 1;
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;
+use Test::More tests => 3;
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
-# This 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;
+use Test::More tests => 10;
{
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;
+use Test::More tests => 3;
{
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;
+use Test::More tests => 2;
{
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;
+use Test::More tests => 1;
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;
+use Test::More tests => 1;
{
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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 15;
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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 36;
use Test::Exception;
+
BEGIN {
package MyRole;
use Mouse::Role;
lives_ok {
MyMetaclass->meta->make_immutable;
-} '... make MyMetaclass immutable okay';
+} '... make MyClass 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 (again) okay';
+} '... make MyClass 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');
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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 2;
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.
-Mouse::Util::remove_metaclass_by_name('MyClass');
+Class::MOP::remove_metaclass_by_name('MyClass');
# The bug happened when DEMOLISHALL called
-# Mouse::Util::class_of($object) and did not get a metaclass object
+# Class::MOP::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;
-Mouse::Util::remove_metaclass_by_name('MyClass');
+Class::MOP::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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 10;
{
package Ball;
undef $method_meta;
}
-
-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::More tests => 20;
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;
+use Test::More tests => 30;
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
-use Test::Requires {
- 'Declare::Constraints::Simple' => '0.01', # skip all if not installed
-};
+BEGIN {
+ eval "use Declare::Constraints::Simple;";
+ plan skip_all => "Declare::Constraints::Simple is required for this test" if $@;
+ plan tests => 9;
+}
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
-use Test::Requires {
- 'Test::Deep' => '0.01', # skip all if not installed
-};
+BEGIN {
+ eval "use Test::Deep;";
+ plan skip_all => "Test::Deep is required for this test" if $@;
+ plan tests => 5;
+}
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;
+use Test::More tests => 23;
=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;
+use Test::More tests => 8;
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;
-$TODO = q{Mouse is not yet completed};
+use Test::More tests => 15;
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" );
- lives_ok { $meta->make_mutable } "Foo is mutable";
- lives_ok { $meta->add_role($foo_role) } "Add Role is unlocked";
+ 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";
+ };
}
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;
+use Test::More tests => 10;
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 Mouse::Meta::Attribute object.
+as with a Class::MOP::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;
+use Test::More tests => 5;
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;
+use Test::More tests => 2;
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;
+use Test::More tests => 14;
{
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 $o = $class->new(42, baz => 47);
- is($o->bar, 42, '... got the right bar');
- is($o->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 $ob = $class->new(42, baz => 47);
+ is($ob->bar, 42, '... got the right bar');
+ is($ob->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;
+++ /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;
#!/usr/bin/perl
-# This is automatically generated by author/import-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::More tests => 8;
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
-#!/usr/bin/perl
-# This is automatically generated by author/import-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;
package MooseCompat;
# Moose compatible methods/functions
-use Mouse ();
-use Mouse::Util::MetaRole;
-use Mouse::Meta::Method;
-use Mouse::Meta::Role::Method;
-
-$INC{'Mouse/Meta.pm'} = __FILE__;
-$INC{'Mouse/Meta/Instance.pm'} = __FILE__;
-$INC{'Mouse/Deprecated.pm'} = __FILE__;
-
-
-*UNIVERSAL::DOES = sub {
- my($thing, $role) = @_;
- $thing->isa($role);
-} unless UNIVERSAL->can('DOES');
-
-$Mouse::Deprecated::deprecated = $Mouse::Deprecated::deprecated = undef; # -w
-
-package Mouse::Util;
-
-sub resolve_metatrait_alias {
- return resolve_metaclass_alias( @_, trait => 1);
-}
-
-sub ensure_all_roles {
- my $consumer = shift;
- apply_all_roles($consumer, grep { !does_role($appicant, $_) } @_);
- return;
-}
package Mouse::Meta::Module;
);
}
-sub role_applications { }
-
package Mouse::Meta::Role;
for my $modifier_type (qw/before after around/) {
return keys %{ $self->{$modifier_type . '_method_modifiers'} };
}
-package Mouse::Meta::Method;
-
-sub get_original_method { Mouse::Meta::Method->wrap(sub { }) }
-
-sub associated_attribute { undef }
-
package Mouse::Util::TypeConstraints;
use Mouse::Util::TypeConstraints ();
return;
}
-package Mouse::Meta::Attribute;
+package
+ Mouse::Meta::Attribute;
sub applied_traits{ $_[0]->{traits} } # TEST ONLY
sub has_applied_traits{ exists $_[0]->{traits} } # TEST ONLY
-sub get_raw_value { undef } # not supported
-sub set_raw_value { undef } # not supported
-
-package Mouse::Meta::TypeConstraint;
-
-sub has_message { exists $_[0]->{message} }
-
-sub validate {
- my($self, $value) = @_;
- return $self->check($value) ? undef : $self->get_message($value);
-}
-
-sub is_subtype_of {
- my($self, $other) = @_;
- return undef; # not supported
-}
-
-sub equals {
- my($self, $other) = @_;
- return undef; # not supported
-}
-
-sub class { undef }
-sub role { undef }
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