Moose-2.1405HEADMoose-2.1405master

36 files changed, 1825 insertions, 0 deletions

diff --git a/t/bugs/DEMOLISHALL.t b/t/bugs/DEMOLISHALL.t
new file mode 100644
index 0000000..43d831e
--- /dev/null
+++ b/t/bugs/DEMOLISHALL.t
@@ -0,0 +1,54 @@
+use strict;
+use warnings;
+use Test::More;
+
+my @called;
+
+do {
+    package Class;
+    use Moose;
+
+    sub DEMOLISH {
+        push @called, 'Class::DEMOLISH';
+    }
+
+    sub DEMOLISHALL {
+        my $self = shift;
+        push @called, 'Class::DEMOLISHALL';
+        $self->SUPER::DEMOLISHALL(@_);
+    }
+
+    package Child;
+    use Moose;
+    extends 'Class';
+
+    sub DEMOLISH {
+        push @called, 'Child::DEMOLISH';
+    }
+
+    sub DEMOLISHALL {
+        my $self = shift;
+        push @called, 'Child::DEMOLISHALL';
+        $self->SUPER::DEMOLISHALL(@_);
+    }
+};
+
+is_deeply([splice @called], [], "no DEMOLISH calls yet");
+
+do {
+    my $object = Class->new;
+
+    is_deeply([splice @called], [], "no DEMOLISH calls yet");
+};
+
+is_deeply([splice @called], ['Class::DEMOLISHALL', 'Class::DEMOLISH']);
+
+do {
+    my $child = Child->new;
+    is_deeply([splice @called], [], "no DEMOLISH calls yet");
+
+};
+
+is_deeply([splice @called], ['Child::DEMOLISHALL', 'Class::DEMOLISHALL', 'Child::DEMOLISH', 'Class::DEMOLISH']);
+
+done_testing;
diff --git a/t/bugs/DEMOLISHALL_shortcutted.t b/t/bugs/DEMOLISHALL_shortcutted.t
new file mode 100644
index 0000000..9095791
--- /dev/null
+++ b/t/bugs/DEMOLISHALL_shortcutted.t
@@ -0,0 +1,35 @@
+use strict;
+use warnings;
+
+## This test ensures that sub DEMOLISHALL fires even if there is no sub DEMOLISH
+## Currently fails because of a bad optimization in DESTROY
+## Feb 12, 2009 -- Evan Carroll me@evancarroll.com
+package Role::DemolishAll;
+use Moose::Role;
+our $ok = 0;
+
+sub BUILD { $ok = 0 };
+after 'DEMOLISHALL' => sub { $Role::DemolishAll::ok++ };
+
+package DemolishAll::WithoutDemolish;
+use Moose;
+with 'Role::DemolishAll';
+
+package DemolishAll::WithDemolish;
+use Moose;
+with 'Role::DemolishAll';
+sub DEMOLISH {};
+
+
+package main;
+use Test::More;
+
+my $m = DemolishAll::WithDemolish->new;
+undef $m;
+is ( $Role::DemolishAll::ok, 1, 'DemolishAll w/ explicit DEMOLISH sub' );
+
+$m = DemolishAll::WithoutDemolish->new;
+undef $m;
+is ( $Role::DemolishAll::ok, 1, 'DemolishAll wo/ explicit DEMOLISH sub' );
+
+done_testing;
diff --git a/t/bugs/DEMOLISH_eats_exceptions.t b/t/bugs/DEMOLISH_eats_exceptions.t
new file mode 100644
index 0000000..c8e9bb1
--- /dev/null
+++ b/t/bugs/DEMOLISH_eats_exceptions.t
@@ -0,0 +1,149 @@
+use strict;
+use warnings;
+use FindBin;
+
+use Test::More;
+
+use Moose::Util::TypeConstraints;
+
+subtype 'FilePath'
+    => as 'Str'
+    # This used to try to _really_ check for a valid Unix or Windows
+    # path, but the regex wasn't quite right, and all we care about
+    # for the tests is that it rejects '/'
+    => where { $_ ne '/' };
+{
+    package Baz;
+    use Moose;
+    use Moose::Util::TypeConstraints;
+
+    has 'path' => (
+        is       => 'ro',
+        isa      => 'FilePath',
+        required => 1,
+    );
+
+    sub BUILD {
+        my ( $self, $params ) = @_;
+        confess $params->{path} . " does not exist"
+            unless -e $params->{path};
+    }
+
+    # Defining this causes the FIRST call to Baz->new w/o param to fail,
+    # if no call to ANY Moose::Object->new was done before.
+    sub DEMOLISH {
+        my ( $self ) = @_;
+    }
+}
+
+{
+    package Qee;
+    use Moose;
+    use Moose::Util::TypeConstraints;
+
+    has 'path' => (
+        is       => 'ro',
+        isa      => 'FilePath',
+        required => 1,
+    );
+
+    sub BUILD {
+        my ( $self, $params ) = @_;
+        confess $params->{path} . " does not exist"
+            unless -e $params->{path};
+    }
+
+    # Defining this causes the FIRST call to Qee->new w/o param to fail...
+    # if no call to ANY Moose::Object->new was done before.
+    sub DEMOLISH {
+        my ( $self ) = @_;
+    }
+}
+
+{
+    package Foo;
+    use Moose;
+    use Moose::Util::TypeConstraints;
+
+    has 'path' => (
+        is       => 'ro',
+        isa      => 'FilePath',
+        required => 1,
+    );
+
+    sub BUILD {
+        my ( $self, $params ) = @_;
+        confess $params->{path} . " does not exist"
+            unless -e $params->{path};
+    }
+
+    # Having no DEMOLISH, everything works as expected...
+}
+
+check_em ( 'Baz' );     #     'Baz plain' will fail, aka NO error
+check_em ( 'Qee' );     #     ok
+check_em ( 'Foo' );     #     ok
+
+check_em ( 'Qee' );     #     'Qee plain' will fail, aka NO error
+check_em ( 'Baz' );     #     ok
+check_em ( 'Foo' );     #     ok
+
+check_em ( 'Foo' );     #     ok
+check_em ( 'Baz' );     #     ok !
+check_em ( 'Qee' );     #     ok
+
+
+sub check_em {
+     my ( $pkg ) = @_;
+     my ( %param, $obj );
+
+     # Uncomment to see, that it is really any first call.
+     # Subsequents calls will not fail, aka giving the correct error.
+     {
+         local $@;
+         my $obj = eval { $pkg->new; };
+         ::like( $@, qr/is required/, "... $pkg plain" );
+         ::is( $obj, undef, "... the object is undef" );
+     }
+     {
+         local $@;
+         my $obj = eval { $pkg->new(); };
+         ::like( $@, qr/is required/, "... $pkg empty" );
+         ::is( $obj, undef, "... the object is undef" );
+     }
+     {
+         local $@;
+         my $obj = eval { $pkg->new ( notanattr => 1 ); };
+         ::like( $@, qr/is required/, "... $pkg undef" );
+         ::is( $obj, undef, "... the object is undef" );
+     }
+
+     {
+         local $@;
+         my $obj = eval { $pkg->new ( %param ); };
+         ::like( $@, qr/is required/, "... $pkg undef param" );
+         ::is( $obj, undef, "... the object is undef" );
+     }
+     {
+         local $@;
+         my $obj = eval { $pkg->new ( path => '/' ); };
+         ::like( $@, qr/does not pass the type constraint/, "... $pkg root path forbidden" );
+         ::is( $obj, undef, "... the object is undef" );
+     }
+     {
+         local $@;
+         my $obj = eval { $pkg->new ( path => '/this_path/does/not_exist' ); };
+         ::like( $@, qr/does not exist/, "... $pkg non existing path" );
+         ::is( $obj, undef, "... the object is undef" );
+     }
+     {
+         local $@;
+         my $obj = eval { $pkg->new ( path => $FindBin::Bin ); };
+         ::is( $@, '', "... $pkg no error" );
+         ::isa_ok( $obj, $pkg );
+         ::isa_ok( $obj, 'Moose::Object' );
+         ::is( $obj->path, $FindBin::Bin, "... $pkg got the right value" );
+     }
+}
+
+done_testing;
diff --git a/t/bugs/DEMOLISH_eats_mini.t b/t/bugs/DEMOLISH_eats_mini.t
new file mode 100644
index 0000000..ab09e8a
--- /dev/null
+++ b/t/bugs/DEMOLISH_eats_mini.t
@@ -0,0 +1,79 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+
+{
+    package Foo;
+    use Moose;
+
+    has 'bar' => (
+        is       => 'ro',
+        required => 1,
+    );
+
+    # Defining this causes the FIRST call to Baz->new w/o param to fail,
+    # if no call to ANY Moose::Object->new was done before.
+    sub DEMOLISH {
+        my ( $self ) = @_;
+        # ... Moose (kinda) eats exceptions in DESTROY/DEMOLISH";
+    }
+}
+
+{
+    my $obj = eval { Foo->new; };
+    like( $@, qr/is required/, "... Foo plain" );
+    is( $obj, undef, "... the object is undef" );
+}
+
+{
+    package Bar;
+
+    sub new { die "Bar died"; }
+
+    sub DESTROY {
+        die "Vanilla Perl eats exceptions in DESTROY too";
+    }
+}
+
+{
+    my $obj = eval { Bar->new; };
+    like( $@, qr/Bar died/, "... Bar plain" );
+    is( $obj, undef, "... the object is undef" );
+}
+
+{
+    package Baz;
+    use Moose;
+
+    sub DEMOLISH {
+        $? = 0;
+    }
+}
+
+{
+    local $@ = 42;
+    local $? = 84;
+
+    {
+        Baz->new;
+    }
+
+    is( $@, 42, '$@ is still 42 after object is demolished without dying' );
+    is( $?, 84, '$? is still 84 after object is demolished without dying' );
+
+    local $@ = 0;
+
+    {
+        Baz->new;
+    }
+
+    is( $@, 0, '$@ is still 0 after object is demolished without dying' );
+
+    Baz->meta->make_immutable, redo
+        if Baz->meta->is_mutable
+}
+
+done_testing;
diff --git a/t/bugs/DEMOLISH_fails_without_metaclass.t b/t/bugs/DEMOLISH_fails_without_metaclass.t
new file mode 100644
index 0000000..b0b0cf4
--- /dev/null
+++ b/t/bugs/DEMOLISH_fails_without_metaclass.t
@@ -0,0 +1,34 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+{
+    package MyClass;
+    use Moose;
+
+    sub DEMOLISH { }
+}
+
+my $object = MyClass->new;
+
+# Removing the metaclass simulates the case where the metaclass object
+# goes out of scope _before_ the object itself, which under normal
+# circumstances only happens during global destruction.
+Class::MOP::remove_metaclass_by_name('MyClass');
+
+# The bug happened when DEMOLISHALL called
+# Class::MOP::class_of($object) and did not get a metaclass object
+# back.
+is( exception { $object->DESTROY }, undef, 'can call DESTROY on an object without a metaclass object in the CMOP cache' );
+
+
+MyClass->meta->make_immutable;
+Class::MOP::remove_metaclass_by_name('MyClass');
+
+# The bug didn't manifest for immutable objects, but this test should
+# help us prevent it happening in the future.
+is( exception { $object->DESTROY }, undef, 'can call DESTROY on an object without a metaclass object in the CMOP cache (immutable version)' );
+
+done_testing;
diff --git a/t/bugs/Moose_Object_error.t b/t/bugs/Moose_Object_error.t
new file mode 100644
index 0000000..b45f092
--- /dev/null
+++ b/t/bugs/Moose_Object_error.t
@@ -0,0 +1,10 @@
+use strict;
+use warnings;
+
+use lib 't/lib';
+
+use Test::More;
+
+use_ok('MyMooseObject');
+
+done_testing;
diff --git a/t/bugs/anon_method_metaclass.t b/t/bugs/anon_method_metaclass.t
new file mode 100644
index 0000000..01c5285
--- /dev/null
+++ b/t/bugs/anon_method_metaclass.t
@@ -0,0 +1,50 @@
+use strict;
+use warnings;
+use Test::More;
+
+{
+    package Ball;
+    use Moose;
+}
+
+{
+    package Arbitrary::Roll;
+    use Moose::Role;
+}
+
+my $method_meta = Moose::Meta::Class->create_anon_class(
+    superclasses => ['Moose::Meta::Method'],
+    roles        => ['Arbitrary::Roll'],
+);
+
+# For comparing identity without actually keeping $original_meta around
+my $original_meta = "$method_meta";
+
+my $method_class = $method_meta->name;
+
+my $method_object = $method_class->wrap(
+    sub {'ok'},
+    associated_metaclass => Ball->meta,
+    package_name         => 'Ball',
+    name                 => 'bounce',
+);
+
+Ball->meta->add_method( bounce => $method_object );
+
+for ( 1, 2 ) {
+    is( Ball->bounce, 'ok', "method still exists on Ball" );
+    is( Ball->meta->get_method('bounce')->meta->name, $method_class,
+        "method's package still exists" );
+
+    is( Ball->meta->get_method('bounce'), $method_object,
+        'original method object is preserved' );
+
+    is( Ball->meta->get_method('bounce')->meta . '', $original_meta,
+        "method's metaclass still exists" );
+    ok( Ball->meta->get_method('bounce')->meta->does_role('Arbitrary::Roll'),
+        "method still does Arbitrary::Roll" );
+
+    undef $method_meta;
+}
+
+done_testing;
diff --git a/t/bugs/application_metarole_compat.t b/t/bugs/application_metarole_compat.t
new file mode 100644
index 0000000..70d17a7
--- /dev/null
+++ b/t/bugs/application_metarole_compat.t
@@ -0,0 +1,56 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Fatal;
+
+BEGIN {
+    {
+        package Foo;
+        use Moose::Role;
+    }
+
+    {
+        package Bar::Class;
+        use Moose::Role;
+    }
+
+    {
+        package Bar::ToClass;
+        use Moose::Role;
+
+        after apply => sub {
+            my $self = shift;
+            my ($role, $class) = @_;
+            Moose::Util::MetaRole::apply_metaroles(
+                for => $class,
+                class_metaroles => {
+                    class => ['Bar::Class'],
+                }
+            );
+        };
+    }
+
+    {
+        package Bar;
+        use Moose::Role;
+        Moose::Util::MetaRole::apply_metaroles(
+            for => __PACKAGE__,
+            role_metaroles => {
+                application_to_class => ['Bar::ToClass'],
+            }
+        );
+    }
+}
+
+{
+    package Parent;
+    use Moose -traits => 'Foo';
+}
+
+{
+    package Child;
+    use Moose -traits => 'Bar';
+    ::is( ::exception { extends 'Parent' }, undef );
+}
+
+done_testing;
diff --git a/t/bugs/apply_role_to_one_instance_only.t b/t/bugs/apply_role_to_one_instance_only.t
new file mode 100644
index 0000000..36df900
--- /dev/null
+++ b/t/bugs/apply_role_to_one_instance_only.t
@@ -0,0 +1,43 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Fatal;
+
+{
+    package MyRole1;
+    use Moose::Role;
+
+    sub a_role_method { 'foo' }
+}
+
+{
+    package MyRole2;
+    use Moose::Role;
+    # empty
+}
+
+{
+    package Foo;
+    use Moose;
+}
+
+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');
+
+is( exception {
+    is $instance_with_role1->a_role_method, 'foo'
+}, undef, 'instance has correct role method' );
+
+done_testing;
diff --git a/t/bugs/attribute_trait_parameters.t b/t/bugs/attribute_trait_parameters.t
new file mode 100644
index 0000000..cd053d1
--- /dev/null
+++ b/t/bugs/attribute_trait_parameters.t
@@ -0,0 +1,46 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Requires 'Test::Output';  # skip all if not installed
+
+{
+    package R;
+    use Moose::Role;
+
+    sub method { }
+}
+
+{
+    package C;
+    use Moose;
+
+    ::stderr_is{
+        has attr => (
+            is => 'ro',
+            traits => [
+                R => { ignored => 1 },
+            ],
+        );
+    } q{}, 'no warning with foreign parameterized attribute traits';
+
+    ::stderr_is{
+        has alias_attr => (
+            is => 'ro',
+            traits => [
+                R => { -alias => { method => 'new_name' } },
+            ],
+        );
+    } q{}, 'no warning with -alias parameterized attribute traits';
+
+    ::stderr_is{
+        has excludes_attr => (
+            is => 'ro',
+            traits => [
+                R => { -excludes => ['method'] },
+            ],
+        );
+    } q{}, 'no warning with -excludes parameterized attribute traits';
+}
+
+done_testing;
diff --git a/t/bugs/augment_recursion_bug.t b/t/bugs/augment_recursion_bug.t
new file mode 100644
index 0000000..e55ca5a
--- /dev/null
+++ b/t/bugs/augment_recursion_bug.t
@@ -0,0 +1,47 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+
+{
+    package Foo;
+    use Moose;
+
+    sub foo { 'Foo::foo(' . (inner() || '') . ')' };
+
+    package Bar;
+    use Moose;
+
+    extends 'Foo';
+
+    package Baz;
+    use Moose;
+
+    extends 'Foo';
+
+    my $foo_call_counter;
+    augment 'foo' => sub {
+        die "infinite loop on Baz::foo" if $foo_call_counter++ > 1;
+        return 'Baz::foo and ' . Bar->new->foo;
+    };
+}
+
+my $baz = Baz->new();
+isa_ok($baz, 'Baz');
+isa_ok($baz, 'Foo');
+
+=pod
+
+When a subclass which augments foo(), calls a subclass which does not augment
+foo(), there is a chance for some confusion. If Moose does not realize that
+Bar does not augment foo(), because it is in the call flow of Baz which does,
+then we may have an infinite loop.
+
+=cut
+
+is($baz->foo,
+  'Foo::foo(Baz::foo and Foo::foo())',
+  '... got the right value for 1 augmented subclass calling non-augmented subclass');
+
+done_testing;
diff --git a/t/bugs/coerce_without_coercion.t b/t/bugs/coerce_without_coercion.t
new file mode 100644
index 0000000..63b74d3
--- /dev/null
+++ b/t/bugs/coerce_without_coercion.t
@@ -0,0 +1,26 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+use Test::Moose;
+
+{
+    package Foo;
+
+    use Moose;
+
+    ::like(
+        ::exception {
+            has x => (
+                is     => 'rw',
+                isa    => 'HashRef',
+                coerce => 1,
+            )
+        },
+        qr/You cannot coerce an attribute \(x\) unless its type \(HashRef\) has a coercion/,
+        "can't set coerce on an attribute whose type constraint has no coercion"
+    );
+}
+
+done_testing;
diff --git a/t/bugs/constructor_object_overload.t b/t/bugs/constructor_object_overload.t
new file mode 100644
index 0000000..c2d1347
--- /dev/null
+++ b/t/bugs/constructor_object_overload.t
@@ -0,0 +1,19 @@
+use strict;
+use warnings;
+use Test::More;
+
+{
+    package Foo;
+
+    use Moose;
+
+    use overload '""' => sub {''};
+
+    sub bug { 'plenty' }
+
+    __PACKAGE__->meta->make_immutable;
+}
+
+ok(Foo->new()->bug(), 'call constructor on object reference with overloading');
+
+done_testing;
diff --git a/t/bugs/create_anon_recursion.t b/t/bugs/create_anon_recursion.t
new file mode 100644
index 0000000..436048a
--- /dev/null
+++ b/t/bugs/create_anon_recursion.t
@@ -0,0 +1,29 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+BEGIN {
+    plan skip_all => "preloading things makes this test meaningless"
+        if exists $INC{'Moose.pm'};
+}
+
+use Moose::Meta::Class;
+
+$SIG{__WARN__} = sub { die if shift =~ /recurs/ };
+
+TODO:
+{
+    local $TODO
+        = 'Loading Moose::Meta::Class without loading Moose.pm causes weird problems';
+
+    my $meta;
+    is( exception {
+        $meta = Moose::Meta::Class->create_anon_class(
+            superclasses => [ 'Moose::Object', ],
+        );
+    }, undef, 'Class is created successfully' );
+}
+
+done_testing;
diff --git a/t/bugs/create_anon_role_pass.t b/t/bugs/create_anon_role_pass.t
new file mode 100644
index 0000000..1e28d76
--- /dev/null
+++ b/t/bugs/create_anon_role_pass.t
@@ -0,0 +1,39 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+use Moose ();
+
+use lib 't/lib';
+
+{
+    package t::bugs::Bar;
+    use Moose;
+
+    # empty class.
+
+    no Moose;
+    __PACKAGE__->meta->make_immutable();
+
+    1;
+}
+
+my $meta;
+use Data::Dumper;
+isnt ( exception {
+    $meta = Moose::Meta::Class->create_anon_class(
+        superclasses => [ 't::bugs::Bar', ], # any old class will work
+        roles        => [ 'Role::BreakOnLoad', ],
+    )
+}, undef, 'Class dies when attempting composition');
+
+my $except;
+isnt ( $except = exception {
+    $meta = Moose::Meta::Class->create_anon_class(
+        superclasses => [ 't::bugs::Bar', ],
+        roles        => [ 'Role::BreakOnLoad', ],
+    );
+}, undef, 'Class continues to die when attempting composition');
+
+done_testing;
diff --git a/t/bugs/delete_sub_stash.t b/t/bugs/delete_sub_stash.t
new file mode 100644
index 0000000..ce3f968
--- /dev/null
+++ b/t/bugs/delete_sub_stash.t
@@ -0,0 +1,23 @@
+use strict;
+use warnings;
+use Test::More;
+
+use Moose ();
+
+{
+    package Foo;
+    sub bar { 'BAR' }
+}
+
+my $method = \&Foo::bar;
+
+{
+    no strict 'refs';
+    delete ${'::'}{'Foo::'};
+}
+
+my $meta = Moose::Meta::Class->create('Bar');
+$meta->add_method(bar => $method);
+is(Bar->bar, 'BAR');
+
+done_testing;
diff --git a/t/bugs/handles_foreign_class_bug.t b/t/bugs/handles_foreign_class_bug.t
new file mode 100644
index 0000000..4706d08
--- /dev/null
+++ b/t/bugs/handles_foreign_class_bug.t
@@ -0,0 +1,111 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+{
+    package Foo;
+
+    sub new {
+        bless({}, 'Foo')
+    }
+
+    sub a { 'Foo::a' }
+
+    $INC{'Foo.pm'} = __FILE__;
+}
+
+{
+    package Bar;
+    use Moose;
+
+    ::is( ::exception {
+        has 'baz' => (
+            is      => 'ro',
+            isa     => 'Foo',
+            lazy    => 1,
+            default => sub { Foo->new() },
+            handles => qr/^a$/,
+        );
+    }, undef, '... can create the attribute with delegations' );
+
+}
+
+my $bar;
+is( exception {
+    $bar = Bar->new;
+}, undef, '... created the object ok' );
+isa_ok($bar, 'Bar');
+
+is($bar->a, 'Foo::a', '... got the right delgated value');
+
+my @w;
+$SIG{__WARN__} = sub { push @w, "@_" };
+{
+    package Baz;
+    use Moose;
+
+    ::is( ::exception {
+        has 'bar' => (
+            is      => 'ro',
+            isa     => 'Foo',
+            lazy    => 1,
+            default => sub { Foo->new() },
+            handles => qr/.*/,
+        );
+    }, undef, '... can create the attribute with delegations' );
+
+}
+
+is(@w, 0, "no warnings");
+
+
+my $baz;
+is( exception {
+    $baz = Baz->new;
+}, undef, '... created the object ok' );
+isa_ok($baz, 'Baz');
+
+is($baz->a, 'Foo::a', '... got the right delgated value');
+
+
+
+
+
+@w = ();
+
+{
+    package Blart;
+    use Moose;
+
+    ::is( ::exception {
+        has 'bar' => (
+            is      => 'ro',
+            isa     => 'Foo',
+            lazy    => 1,
+            default => sub { Foo->new() },
+            handles => [qw(a new)],
+        );
+    }, undef, '... can create the attribute with delegations' );
+
+}
+
+{
+    local $TODO = "warning not yet implemented";
+
+    is(@w, 1, "one warning");
+    like($w[0], qr/not delegating.*new/i, "warned");
+}
+
+
+
+my $blart;
+is( exception {
+    $blart = Blart->new;
+}, undef, '... created the object ok' );
+isa_ok($blart, 'Blart');
+
+is($blart->a, 'Foo::a', '... got the right delgated value');
+
+done_testing;
diff --git a/t/bugs/immutable_metaclass_does_role.t b/t/bugs/immutable_metaclass_does_role.t
new file mode 100644
index 0000000..00cec0b
--- /dev/null
+++ b/t/bugs/immutable_metaclass_does_role.t
@@ -0,0 +1,90 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+
+BEGIN {
+    package MyRole;
+    use Moose::Role;
+
+    requires 'foo';
+
+    package MyMetaclass;
+    use Moose qw(extends with);
+    extends 'Moose::Meta::Class';
+       with 'MyRole';
+
+    sub foo { 'i am foo' }
+}
+
+{
+    package MyClass;
+    use metaclass ('MyMetaclass');
+    use Moose;
+}
+
+my $mc = MyMetaclass->initialize('MyClass');
+isa_ok($mc, 'MyMetaclass');
+
+ok($mc->meta->does_role('MyRole'), '... the metaclass does the role');
+
+is(MyClass->meta, $mc, '... these metas are the same thing');
+is(MyClass->meta->meta, $mc->meta, '... these meta-metas are the same thing');
+
+my $a = MyClass->new;
+ok( $a->meta->meta->does_role('MyRole'), 'metaclass does MyRole' );
+is( $a->meta->foo, 'i am foo', '... foo method returns expected value' );
+ok( MyClass->meta->meta->does_role('MyRole'), 'metaclass does MyRole' );
+is( MyClass->meta->foo, 'i am foo', '... foo method returns expected value' );
+
+is( exception {
+    MyClass->meta->make_immutable;
+}, undef, '... 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( $a->meta->meta->does_role('MyRole'), 'metaclass does MyRole' );
+is( $a->meta->foo, 'i am foo', '... foo method returns expected value' );
+ok( MyClass->meta->meta->does_role('MyRole'), 'metaclass does MyRole' );
+is( MyClass->meta->foo, 'i am foo', '... foo method returns expected value' );
+
+is( exception {
+    MyClass->meta->make_mutable;
+}, undef, '... make MyClass mutable 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( $a->meta->meta->does_role('MyRole'), 'metaclass does MyRole' );
+is( $a->meta->foo, 'i am foo', '... foo method returns expected value' );
+ok( MyClass->meta->meta->does_role('MyRole'), 'metaclass does MyRole' );
+is( MyClass->meta->foo, 'i am foo', '... foo method returns expected value' );
+
+is( exception {
+    MyMetaclass->meta->make_immutable;
+}, undef, '... make MyMetaclass immutable okay' );
+
+is(MyClass->meta, $mc, '... these metas are still the same thing');
+is(MyClass->meta->meta, $mc->meta, '... these meta-metas are the same thing');
+
+ok( $a->meta->meta->does_role('MyRole'), 'metaclass does MyRole' );
+is( $a->meta->foo, 'i am foo', '... foo method returns expected value' );
+ok( MyClass->meta->meta->does_role('MyRole'), 'metaclass does MyRole' );
+is( MyClass->meta->foo, 'i am foo', '... foo method returns expected value' );
+
+is( exception {
+    MyClass->meta->make_immutable;
+}, undef, '... make MyClass immutable (again) okay' );
+
+is(MyClass->meta, $mc, '... these metas are still the same thing');
+is(MyClass->meta->meta, $mc->meta, '... these meta-metas are the same thing');
+
+ok( $a->meta->meta->does_role('MyRole'), 'metaclass does MyRole' );
+is( $a->meta->foo, 'i am foo', '... foo method returns expected value' );
+ok( MyClass->meta->meta->does_role('MyRole'), 'metaclass does MyRole' );
+is( MyClass->meta->foo, 'i am foo', '... foo method returns expected value' );
+
+done_testing;
diff --git a/t/bugs/immutable_n_default_x2.t b/t/bugs/immutable_n_default_x2.t
new file mode 100644
index 0000000..2ba3e3b
--- /dev/null
+++ b/t/bugs/immutable_n_default_x2.t
@@ -0,0 +1,39 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+
+{
+    package Foo;
+    use Moose;
+
+    our $foo_default_called = 0;
+
+    has foo => (
+        is      => 'rw',
+        isa     => 'Str',
+        default => sub { $foo_default_called++; 'foo' },
+    );
+
+    our $bar_default_called = 0;
+
+    has bar => (
+        is      => 'rw',
+        isa     => 'Str',
+        lazy    => 1,
+        default => sub { $bar_default_called++; 'bar' },
+    );
+
+    __PACKAGE__->meta->make_immutable;
+}
+
+my $foo = Foo->new();
+
+is($Foo::foo_default_called, 1, "foo default was only called once during constructor");
+
+$foo->bar();
+
+is($Foo::bar_default_called, 1, "bar default was only called once when lazy attribute is accessed");
+
+done_testing;
diff --git a/t/bugs/inheriting_from_roles.t b/t/bugs/inheriting_from_roles.t
new file mode 100644
index 0000000..093864b
--- /dev/null
+++ b/t/bugs/inheriting_from_roles.t
@@ -0,0 +1,21 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+
+{
+    package My::Role;
+    use Moose::Role;
+}
+{
+    package My::Class;
+    use Moose;
+
+    ::like( ::exception {
+        extends 'My::Role';
+    }, qr/You cannot inherit from a Moose Role \(My\:\:Role\)/, '... this croaks correctly' );
+}
+
+done_testing;
diff --git a/t/bugs/inline_reader_bug.t b/t/bugs/inline_reader_bug.t
new file mode 100644
index 0000000..ef14f71
--- /dev/null
+++ b/t/bugs/inline_reader_bug.t
@@ -0,0 +1,29 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+
+=pod
+
+This was a bug, but it is fixed now. This
+test makes sure it does not creep back in.
+
+=cut
+
+{
+    package Foo;
+    use Moose;
+
+    ::is( ::exception {
+        has 'bar' => (
+            is      => 'ro',
+            isa     => 'Int',
+            lazy    => 1,
+            default => 10,
+        );
+    }, undef, '... this didnt die' );
+}
+
+done_testing;
diff --git a/t/bugs/instance_application_role_args.t b/t/bugs/instance_application_role_args.t
new file mode 100644
index 0000000..120d12e
--- /dev/null
+++ b/t/bugs/instance_application_role_args.t
@@ -0,0 +1,50 @@
+use strict;
+use warnings;
+use Test::More;
+
+{
+    package Point;
+    use Moose;
+
+    with qw/DoesNegated DoesTranspose/;
+
+    has x => ( isa => 'Int', is => 'rw' );
+    has y => ( isa => 'Int', is => 'rw' );
+
+    sub inspect { [$_[0]->x, $_[0]->y] }
+
+    no Moose;
+}
+
+{
+    package DoesNegated;
+    use Moose::Role;
+
+    sub negated {
+        my $self = shift;
+        $self->new( x => -$self->x, y => -$self->y );
+    }
+
+    no Moose::Role;
+}
+
+{
+    package DoesTranspose;
+    use Moose::Role;
+
+    sub transpose {
+        my $self = shift;
+        $self->new( x => $self->y, y => $self->x );
+    }
+
+    no Moose::Role;
+}
+
+my $p = Point->new( x => 4, y => 3 );
+
+DoesTranspose->meta->apply( $p, -alias => { transpose => 'negated' } );
+
+is_deeply($p->negated->inspect, [3, 4]);
+is_deeply($p->transpose->inspect, [3, 4]);
+
+done_testing;
diff --git a/t/bugs/lazybuild_required_undef.t b/t/bugs/lazybuild_required_undef.t
new file mode 100644
index 0000000..9870587
--- /dev/null
+++ b/t/bugs/lazybuild_required_undef.t
@@ -0,0 +1,33 @@
+use strict;
+use warnings;
+
+package Foo;
+use Moose;
+
+## Problem:
+## lazy_build sets required => 1
+## required does not permit setting to undef
+
+## Possible solutions:
+#### remove required => 1
+#### check the attr to see if it accepts Undef (Maybe[], | Undef)
+#### 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' );
+
+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' );
+
+ok ( !defined(Foo->new->foo), 'LazyBuild: Undef default/lazy_build' );
+
+## This test fails at the time of creation.
+ok ( !defined(Foo->new->foo(undef)), 'LazyBuild: Undef explicit' );
+
+done_testing;
diff --git a/t/bugs/mark_as_methods_overloading_breakage.t b/t/bugs/mark_as_methods_overloading_breakage.t
new file mode 100644
index 0000000..c9e0097
--- /dev/null
+++ b/t/bugs/mark_as_methods_overloading_breakage.t
@@ -0,0 +1,33 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+use Test::Requires {
+    'MooseX::MarkAsMethods' => 0,
+};
+
+{
+    package Role2;
+    use Moose::Role;
+    use MooseX::MarkAsMethods;
+    use overload q{""} => '_stringify';
+    sub _stringify {ref $_[0]}
+}
+
+{
+    package Class2;
+    use Moose;
+    with 'Role2';
+}
+
+ok(! exception {
+    my $class2 = Class2->new;
+    is(
+        "$class2",
+        'Class2',
+        'Class2 got stringification overloading from Role2'
+    );
+}, 'No error creating a Class2 object');
+
+done_testing;
diff --git a/t/bugs/moose_exporter_false_circular_reference_rt_63818.t b/t/bugs/moose_exporter_false_circular_reference_rt_63818.t
new file mode 100644
index 0000000..dd41ce2
--- /dev/null
+++ b/t/bugs/moose_exporter_false_circular_reference_rt_63818.t
@@ -0,0 +1,154 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+# OKSet1
+{
+
+    package TESTING::MooseExporter::Rt63818::OKSet1::ModuleA;
+    use Moose ();
+    Moose::Exporter->setup_import_methods(
+        also => [
+            'Moose',
+        ]
+    );
+}
+
+# OKSet2
+{
+
+    package TESTING::MooseExporter::Rt63818::OKSet2::ModuleA;
+    use Moose ();
+    Moose::Exporter->setup_import_methods(
+        also => [
+            'Moose',
+        ]
+    );
+
+    package TESTING::MooseExporter::Rt63818::OKSet2::ModuleB;
+    use Moose ();
+    Moose::Exporter->setup_import_methods(
+        also => [
+            'Moose',
+        ]
+    );
+}
+
+# OKSet3
+{
+
+    package TESTING::MooseExporter::Rt63818::OKSet3::ModuleA;
+    use Moose ();
+    Moose::Exporter->setup_import_methods(
+        also => [
+            'Moose',
+        ]
+    );
+
+    package TESTING::MooseExporter::Rt63818::OKSet3::ModuleB;
+    use Moose ();
+    Moose::Exporter->setup_import_methods(
+        also => [
+            'Moose',
+            'TESTING::MooseExporter::Rt63818::OKSet3::ModuleA',
+        ]
+    );
+}
+
+# OKSet4
+{
+
+    package TESTING::MooseExporter::Rt63818::OKSet4::ModuleA;
+    use Moose ();
+    Moose::Exporter->setup_import_methods(
+        also => [
+            'Moose',
+        ]
+    );
+
+    package TESTING::MooseExporter::Rt63818::OKSet4::ModuleB;
+    use Moose ();
+    Moose::Exporter->setup_import_methods(
+        also => [
+            'Moose',
+            'TESTING::MooseExporter::Rt63818::OKSet4::ModuleA',
+        ]
+    );
+
+    package TESTING::MooseExporter::Rt63818::OKSet4::ModuleC;
+    use Moose ();
+    Moose::Exporter->setup_import_methods(
+        also => [
+            'Moose',
+            'TESTING::MooseExporter::Rt63818::OKSet4::ModuleA',
+            'TESTING::MooseExporter::Rt63818::OKSet4::ModuleB',
+        ]
+    );
+}
+
+# OKSet5
+{
+
+    package TESTING::MooseExporter::Rt63818::OKSet5::ModuleA;
+    use Moose ();
+    Moose::Exporter->setup_import_methods(
+        also => [
+            'Moose',
+        ]
+    );
+
+    package TESTING::MooseExporter::Rt63818::OKSet5::ModuleB;
+    use Moose ();
+    Moose::Exporter->setup_import_methods(
+        also => [
+            'Moose',
+            'TESTING::MooseExporter::Rt63818::OKSet5::ModuleA',
+        ]
+    );
+
+    package TESTING::MooseExporter::Rt63818::OKSet5::ModuleC;
+    use Moose ();
+    Moose::Exporter->setup_import_methods(
+        also => [
+            'Moose',
+            'TESTING::MooseExporter::Rt63818::OKSet5::ModuleA',
+            'TESTING::MooseExporter::Rt63818::OKSet5::ModuleB',
+        ]
+    );
+
+    package TESTING::MooseExporter::Rt63818::OKSet5::ModuleD;
+    use Moose ();
+    Moose::Exporter->setup_import_methods(
+        also => [
+            'Moose',
+            'TESTING::MooseExporter::Rt63818::OKSet5::ModuleA',
+            'TESTING::MooseExporter::Rt63818::OKSet5::ModuleC',
+        ]
+    );
+}
+
+# NotOKSet1
+{
+
+    package TESTING::MooseExporter::Rt63818::NotOKSet1::ModuleA;
+    use Moose ();
+    ::like(
+        ::exception { Moose::Exporter->setup_import_methods(
+                also => [
+                    'Moose',
+                    'TESTING::MooseExporter::Rt63818::NotOKSet1::ModuleA',
+                ]
+            )
+            },
+        qr/\QCircular reference in 'also' parameter to Moose::Exporter between TESTING::MooseExporter::Rt63818::NotOKSet1::ModuleA and TESTING::MooseExporter::Rt63818::NotOKSet1::ModuleA/,
+        'a single-hop circular reference in also dies with an error'
+    );
+}
+
+# Alas, I've not figured out how to craft a test which shows that we get the
+# same error for multi-hop circularity... instead I get tests that die because
+# one of the circularly-referenced things was not loaded.
+
+done_testing;
diff --git a/t/bugs/moose_octal_defaults.t b/t/bugs/moose_octal_defaults.t
new file mode 100644
index 0000000..42a0fb5
--- /dev/null
+++ b/t/bugs/moose_octal_defaults.t
@@ -0,0 +1,121 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+{
+    my $package = qq{
+package Test::Moose::Go::Boom;
+use Moose;
+use lib qw(lib);
+
+has id => (
+    isa     => 'Str',
+    is      => 'ro',
+    default => '019600', # this caused the original failure
+);
+
+no Moose;
+
+__PACKAGE__->meta->make_immutable;
+};
+
+    eval $package;
+    $@ ? ::fail($@) : ::pass('quoted 019600 default works');
+    my $obj = Test::Moose::Go::Boom->new;
+    ::is( $obj->id, '019600', 'value is still the same' );
+}
+
+{
+    my $package = qq{
+package Test::Moose::Go::Boom2;
+use Moose;
+use lib qw(lib);
+
+has id => (
+    isa     => 'Str',
+    is      => 'ro',
+    default => 017600,
+);
+
+no Moose;
+
+__PACKAGE__->meta->make_immutable;
+};
+
+    eval $package;
+    $@ ? ::fail($@) : ::pass('017600 octal default works');
+    my $obj = Test::Moose::Go::Boom2->new;
+    ::is( $obj->id, 8064, 'value is still the same' );
+}
+
+{
+    my $package = qq{
+package Test::Moose::Go::Boom3;
+use Moose;
+use lib qw(lib);
+
+has id => (
+    isa     => 'Str',
+    is      => 'ro',
+    default => 0xFF,
+);
+
+no Moose;
+
+__PACKAGE__->meta->make_immutable;
+};
+
+    eval $package;
+    $@ ? ::fail($@) : ::pass('017600 octal default works');
+    my $obj = Test::Moose::Go::Boom3->new;
+    ::is( $obj->id, 255, 'value is still the same' );
+}
+
+{
+    my $package = qq{
+package Test::Moose::Go::Boom4;
+use Moose;
+use lib qw(lib);
+
+has id => (
+    isa     => 'Str',
+    is      => 'ro',
+    default => '0xFF',
+);
+
+no Moose;
+
+__PACKAGE__->meta->make_immutable;
+};
+
+    eval $package;
+    $@ ? ::fail($@) : ::pass('017600 octal default works');
+    my $obj = Test::Moose::Go::Boom4->new;
+    ::is( $obj->id, '0xFF', 'value is still the same' );
+}
+
+{
+    my $package = qq{
+package Test::Moose::Go::Boom5;
+use Moose;
+use lib qw(lib);
+
+has id => (
+    isa     => 'Str',
+    is      => 'ro',
+    default => '0 but true',
+);
+
+no Moose;
+
+__PACKAGE__->meta->make_immutable;
+};
+
+    eval $package;
+    $@ ? ::fail($@) : ::pass('017600 octal default works');
+    my $obj = Test::Moose::Go::Boom5->new;
+    ::is( $obj->id, '0 but true', 'value is still the same' );
+}
+
+done_testing;
diff --git a/t/bugs/native_trait_handles_bad_value.t b/t/bugs/native_trait_handles_bad_value.t
new file mode 100644
index 0000000..34824aa
--- /dev/null
+++ b/t/bugs/native_trait_handles_bad_value.t
@@ -0,0 +1,27 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+{
+
+    package Bug;
+    use Moose;
+
+    ::like(
+        ::exception{ has member => (
+                is      => 'ro',
+                isa     => 'HashRef',
+                traits  => ['Hash'],
+                handles => {
+                    method => sub { }
+                },
+            );
+            },
+        qr/\QAll values passed to handles must be strings or ARRAY references, not CODE/,
+        'bad value in handles throws a useful error'
+    );
+}
+
+done_testing;
diff --git a/t/bugs/overloading_edge_cases.t b/t/bugs/overloading_edge_cases.t
new file mode 100644
index 0000000..af2abfc
--- /dev/null
+++ b/t/bugs/overloading_edge_cases.t
@@ -0,0 +1,43 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+{
+    package Role::Overloads;
+    use Moose::Role;
+    use overload q{""} => 'as_string';
+    requires 'as_string';
+}
+
+{
+    package Class::Overloads;
+    use Moose;
+    with 'Role::Overloads';
+    sub as_string { 'foo' }
+}
+
+is(
+    Class::Overloads->new() . q{}, 'foo',
+    'Class::Overloads overloads stringification with overloading defined in role and method defined in class'
+);
+
+{
+    package Parent::NoOverloads;
+    use Moose;
+    sub name { ref $_[0] }
+}
+
+{
+    package Child::Overloads;
+    use Moose;
+    use overload q{""} => 'name';
+    extends 'Parent::NoOverloads';
+}
+
+is(
+    Child::Overloads->new() . q{}, 'Child::Overloads',
+    'Child::Overloads overloads stringification with method inherited from parent'
+);
+
+done_testing;
diff --git a/t/bugs/reader_precedence_bug.t b/t/bugs/reader_precedence_bug.t
new file mode 100644
index 0000000..e223a14
--- /dev/null
+++ b/t/bugs/reader_precedence_bug.t
@@ -0,0 +1,21 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+{
+    package Foo;
+    use Moose;
+    has 'foo' => ( is => 'ro', reader => 'get_foo' );
+}
+
+{
+    my $foo = Foo->new(foo => 10);
+    my $reader = $foo->meta->get_attribute('foo')->reader;
+    is($reader, 'get_foo',
+       'reader => "get_foo" has correct presedence');
+    can_ok($foo, 'get_foo');
+    is($foo->$reader, 10, "Reader works as expected");
+}
+
+done_testing;
diff --git a/t/bugs/role_caller.t b/t/bugs/role_caller.t
new file mode 100644
index 0000000..6fdf5a1
--- /dev/null
+++ b/t/bugs/role_caller.t
@@ -0,0 +1,30 @@
+use strict;
+use warnings;
+
+package MyRole;
+
+use Moose::Role;
+
+sub foo { return (caller(0))[3] }
+
+no Moose::Role;
+
+package MyClass1; use Moose; with 'MyRole'; no Moose;
+package MyClass2; use Moose; with 'MyRole'; no Moose;
+
+package main;
+
+use Test::More;
+
+{
+  local $TODO = 'Role composition does not clone methods yet';
+  is(MyClass1->foo, 'MyClass1::foo',
+    'method from role has correct name in caller()');
+  is(MyClass2->foo, 'MyClass2::foo',
+    'method from role has correct name in caller()');
+}
+
+isnt(MyClass1->foo, "MyClass2::foo", "role method is not confused with other class" );
+isnt(MyClass2->foo, "MyClass1::foo", "role method is not confused with other class" );
+
+done_testing;
diff --git a/t/bugs/subclass_use_base_bug.t b/t/bugs/subclass_use_base_bug.t
new file mode 100644
index 0000000..9a4521c
--- /dev/null
+++ b/t/bugs/subclass_use_base_bug.t
@@ -0,0 +1,28 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+=pod
+
+This just makes sure that the Bar gets
+a metaclass initialized for it correctly.
+
+=cut
+
+{
+    package Foo;
+    use Moose;
+
+    package Bar;
+    use strict;
+    use warnings;
+
+    use parent -norequire => 'Foo';
+}
+
+my $bar = Bar->new;
+isa_ok($bar, 'Bar');
+isa_ok($bar, 'Foo');
+
+done_testing;
diff --git a/t/bugs/subtype_conflict_bug.t b/t/bugs/subtype_conflict_bug.t
new file mode 100644
index 0000000..93125cd
--- /dev/null
+++ b/t/bugs/subtype_conflict_bug.t
@@ -0,0 +1,11 @@
+use strict;
+use warnings;
+
+use lib 't/lib';
+
+use Test::More;
+
+use_ok('MyMooseA');
+use_ok('MyMooseB');
+
+done_testing;
diff --git a/t/bugs/subtype_quote_bug.t b/t/bugs/subtype_quote_bug.t
new file mode 100644
index 0000000..a507759
--- /dev/null
+++ b/t/bugs/subtype_quote_bug.t
@@ -0,0 +1,34 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+=pod
+
+This is a test for a bug found by Purge on #moose:
+The code:
+
+  subtype Stuff
+    => as Object
+    => where { ... }
+
+will break if the Object:: namespace exists. So the
+solution is to quote 'Object', like so:
+
+  subtype Stuff
+    => as 'Object'
+    => where { ... }
+
+Moose 0.03 did this, now it doesn't, so all should
+be well from now on.
+
+=cut
+
+{ package Object::Test; }
+
+{
+    package Foo;
+    ::use_ok('Moose');
+}
+
+done_testing;
diff --git a/t/bugs/super_recursion.t b/t/bugs/super_recursion.t
new file mode 100644
index 0000000..b6d920f
--- /dev/null
+++ b/t/bugs/super_recursion.t
@@ -0,0 +1,69 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+{
+    package First;
+    use Moose;
+
+    sub foo {
+        ::BAIL_OUT('First::foo called twice') if $main::seen{'First::foo'}++;
+        return '1';
+    }
+
+    sub bar {
+        ::BAIL_OUT('First::bar called twice') if $main::seen{'First::bar'}++;
+        return '1';
+    }
+
+    sub baz {
+        ::BAIL_OUT('First::baz called twice') if $main::seen{'First::baz'}++;
+        return '1';
+    }
+}
+
+{
+    package Second;
+    use Moose;
+    extends qw(First);
+
+    sub foo {
+        ::BAIL_OUT('Second::foo called twice') if $main::seen{'Second::foo'}++;
+        return '2' . super();
+    }
+
+    sub bar {
+        ::BAIL_OUT('Second::bar called twice') if $main::seen{'Second::bar'}++;
+        return '2' . ( super() || '' );
+    }
+
+    override baz => sub {
+        ::BAIL_OUT('Second::baz called twice') if $main::seen{'Second::baz'}++;
+        return '2' . super();
+    };
+}
+
+{
+    package Third;
+    use Moose;
+    extends qw(Second);
+
+    sub foo { return '3' . ( super() || '' ) }
+
+    override bar => sub {
+        ::BAIL_OUT('Third::bar called twice') if $main::seen{'Third::bar'}++;
+        return '3' . super();
+    };
+
+    override baz => sub {
+        ::BAIL_OUT('Third::baz called twice') if $main::seen{'Third::baz'}++;
+        return '3' . super();
+    };
+}
+
+is( Third->new->foo, '3' );
+is( Third->new->bar, '32' );
+is( Third->new->baz, '321' );
+
+done_testing;
diff --git a/t/bugs/traits_with_exporter.t b/t/bugs/traits_with_exporter.t
new file mode 100644
index 0000000..8f4fe92
--- /dev/null
+++ b/t/bugs/traits_with_exporter.t
@@ -0,0 +1,77 @@
+use strict;
+use warnings;
+
+use Test::More;
+use lib 't/lib';
+
+BEGIN {
+    package MyExporterRole;
+
+    use Moose ();
+    use Moose::Exporter;
+
+    Moose::Exporter->setup_import_methods(
+        also      => 'Moose',
+    );
+
+    sub init_meta {
+        my ($class,%args) = @_;
+
+        my $meta = Moose->init_meta( %args );
+
+        Moose::Util::MetaRole::apply_metaroles(
+            for             => $meta,
+            class_metaroles => {
+                class           => ['MyMetaRole'],
+            },
+        );
+
+        return $meta;
+    }
+
+    $INC{'MyExporterRole.pm'} = __FILE__;
+}
+
+{
+    package MyMetaRole;
+    use Moose::Role;
+
+    sub some_meta_class_method {
+        return "HEY"
+    }
+}
+
+{
+    package MyTrait;
+    use Moose::Role;
+
+    sub some_meta_class_method_defined_by_trait {
+        return "HO"
+    }
+
+    {
+        package Moose::Meta::Class::Custom::Trait::MyClassTrait;
+        use strict;
+        use warnings;
+        sub register_implementation { return 'MyTrait' }
+    }
+}
+
+{
+    package MyClass;
+    use MyExporterRole -traits => 'MyClassTrait';
+}
+
+
+
+my $my_class = MyClass->new;
+
+isa_ok($my_class,'MyClass');
+
+my $meta = $my_class->meta();
+# Check if MyMetaRole has been applied
+ok($meta->can('some_meta_class_method'),'Meta class has some_meta_class_method');
+# Check if MyTrait has been applied
+ok($meta->can('some_meta_class_method_defined_by_trait'),'Meta class has some_meta_class_method_defined_by_trait');
+
+done_testing;
diff --git a/t/bugs/type_constraint_messages.t b/t/bugs/type_constraint_messages.t
new file mode 100644
index 0000000..5bb076b
--- /dev/null
+++ b/t/bugs/type_constraint_messages.t
@@ -0,0 +1,65 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+
+# RT #37569
+
+{
+    package MyObject;
+    use Moose;
+
+    package Foo;
+    use Moose;
+    use Moose::Util::TypeConstraints;
+
+    subtype 'MyArrayRef'
+       => as 'ArrayRef'
+       => where { defined $_->[0] }
+       => message { ref $_ ? "ref: ". ref $_ : 'scalar' }  # stringy
+    ;
+
+    subtype 'MyObjectType'
+       => as 'Object'
+       => where { $_->isa('MyObject') }
+       => message {
+          if ( $_->isa('SomeObject') ) {
+            return 'More detailed error message';
+          }
+          elsif ( blessed $_ ) {
+            return 'Well it is an object';
+          }
+          else {
+            return 'Doh!';
+          }
+       }
+    ;
+
+    type 'NewType'
+       => where { $_->isa('MyObject') }
+       => message { blessed $_ ? 'blessed' : 'scalar' }
+    ;
+
+    has 'obj' => ( is => 'rw', isa => 'MyObjectType' );
+    has 'ar'  => ( is => 'rw', isa => 'MyArrayRef' );
+    has 'nt'  => ( is => 'rw', isa => 'NewType' );
+}
+
+my $foo = Foo->new;
+my $obj = MyObject->new;
+
+like( exception {
+    $foo->ar( [] );
+}, qr/Attribute \(ar\) does not pass the type constraint because: ref: ARRAY/, '... got the right error message' );
+
+like( exception {
+    $foo->obj($foo);    # Doh!
+}, qr/Attribute \(obj\) does not pass the type constraint because: Well it is an object/, '... got the right error message' );
+
+like( exception {
+    $foo->nt($foo);     # scalar
+}, qr/Attribute \(nt\) does not pass the type constraint because: blessed/, '... got the right error message' );
+
+done_testing;