Moose-2.1405HEADMoose-2.1405master

17 files changed, 1172 insertions, 0 deletions

diff --git a/t/immutable/apply_roles_to_immutable.t b/t/immutable/apply_roles_to_immutable.t
new file mode 100644
index 0000000..206cd16
--- /dev/null
+++ b/t/immutable/apply_roles_to_immutable.t
@@ -0,0 +1,38 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+
+{
+    package My::Role;
+    use Moose::Role;
+
+    around 'baz' => sub {
+        my $next = shift;
+        'My::Role::baz(' . $next->(@_) . ')';
+    };
+}
+
+{
+    package Foo;
+    use Moose;
+
+    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');
+
+is( exception {
+    My::Role->meta->apply($foo)
+}, undef, '... successfully applied the role to immutable instance' );
+
+is($foo->baz, 'My::Role::baz(Foo::baz)', '... got the right value');
+
+done_testing;
diff --git a/t/immutable/buildargs.t b/t/immutable/buildargs.t
new file mode 100644
index 0000000..338e520
--- /dev/null
+++ b/t/immutable/buildargs.t
@@ -0,0 +1,45 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+{
+    package Foo;
+    use Moose;
+
+    has bar => ( is => "rw" );
+    has baz => ( is => "rw" );
+
+    sub BUILDARGS {
+        my ( $self, @args ) = @_;
+        unshift @args, "bar" if @args % 2 == 1;
+        return {@args};
+    }
+
+    __PACKAGE__->meta->make_immutable;
+
+    package Bar;
+    use Moose;
+
+    extends qw(Foo);
+
+    __PACKAGE__->meta->make_immutable;
+}
+
+foreach my $class (qw(Foo Bar)) {
+    is( $class->new->bar, undef, "no args" );
+    is( $class->new( bar => 42 )->bar, 42, "normal args" );
+    is( $class->new( 37 )->bar, 37, "single arg" );
+    {
+        my $o = $class->new(bar => 42, baz => 47);
+        is($o->bar, 42, '... got the right bar');
+        is($o->baz, 47, '... got the right bar');
+    }
+    {
+        my $o = $class->new(42, baz => 47);
+        is($o->bar, 42, '... got the right bar');
+        is($o->baz, 47, '... got the right bar');
+    }
+}
+
+done_testing;
diff --git a/t/immutable/constructor_is_not_moose.t b/t/immutable/constructor_is_not_moose.t
new file mode 100644
index 0000000..43e9ec9
--- /dev/null
+++ b/t/immutable/constructor_is_not_moose.t
@@ -0,0 +1,100 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Requires 'Test::Output';  # skip all if not installed
+
+{
+    package NotMoose;
+
+    sub new {
+        my $class = shift;
+
+        return bless { not_moose => 1 }, $class;
+    }
+}
+
+{
+    package Foo;
+    use Moose;
+
+    extends 'NotMoose';
+
+    ::stderr_like(
+        sub { Foo->meta->make_immutable },
+        qr/\QNot inlining 'new' for Foo since it is not inheriting the default Moose::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 Moose;
+
+    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 Moose;
+
+    Baz->meta->make_immutable;
+}
+
+{
+    package Quux;
+    use Moose;
+
+    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 parent 'Moose::Meta::Method::Constructor';
+}
+
+{
+    package CustomCons;
+    use Moose;
+
+    CustomCons->meta->make_immutable( constructor_class => 'My::Constructor' );
+}
+
+{
+    package Subclass;
+    use Moose;
+
+    extends 'CustomCons';
+
+    ::stderr_is(
+        sub { Subclass->meta->make_immutable },
+        q{},
+        'no warning when inheriting from a class that has already made itself immutable'
+    );
+}
+
+done_testing;
diff --git a/t/immutable/constructor_is_wrapped.t b/t/immutable/constructor_is_wrapped.t
new file mode 100644
index 0000000..820d7e9
--- /dev/null
+++ b/t/immutable/constructor_is_wrapped.t
@@ -0,0 +1,27 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Requires 'Test::Output';  # skip all if not installed
+
+{
+    package ModdedNew;
+    use Moose;
+
+    before 'new' => sub { };
+}
+
+{
+    package Foo;
+    use Moose;
+
+    extends 'ModdedNew';
+
+    ::stderr_like(
+        sub { Foo->meta->make_immutable },
+        qr/\QNot inlining 'new' for Foo since it has method modifiers which would be lost if it were inlined/,
+        'got a warning that Foo may not have an inlined constructor'
+    );
+}
+
+done_testing;
diff --git a/t/immutable/default_values.t b/t/immutable/default_values.t
new file mode 100644
index 0000000..81c57f7
--- /dev/null
+++ b/t/immutable/default_values.t
@@ -0,0 +1,79 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+{
+
+    package Foo;
+    use Moose;
+
+    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} );
+
+    ::is( ::exception {  __PACKAGE__->meta->make_immutable }, undef, '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.
+# Also make sure that attributes stay lazy even after being immutable
+
+{
+
+    package Bar;
+    use Moose;
+
+    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 );
+
+    {
+        my $bar = Bar->new;
+        ::ok(!$bar->meta->get_attribute($_)->has_value($bar),
+             "Attribute $_ has no value")
+            for qw(foo bar baz buz faz);
+    }
+
+    ::is( ::exception {  __PACKAGE__->meta->make_immutable }, undef, 'no errors making a package immutable when it has lazy default values that could break quoting' );
+
+    {
+        my $bar = Bar->new;
+        ::ok(!$bar->meta->get_attribute($_)->has_value($bar),
+             "Attribute $_ has no value (immutable)")
+            for(qw(foo bar baz buz faz));
+    }
+
+}
+
+my $bar = Bar->new;
+is( $bar->foo, q{'},
+    'default value for foo attr' );
+is( $bar->bar, q{\\},
+    'default value for bar attr' );
+is( $bar->baz, q{"},
+    'default value for baz attr' );
+is( $bar->buz, q{"'\\},
+    'default value for buz attr' );
+is( $bar->faz, qq{\0},
+    'default value for faz attr' );
+
+done_testing;
diff --git a/t/immutable/definition_context.t b/t/immutable/definition_context.t
new file mode 100644
index 0000000..71482df
--- /dev/null
+++ b/t/immutable/definition_context.t
@@ -0,0 +1,82 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Fatal;
+
+{
+    use Moose::Util::TypeConstraints;
+    use Carp 'confess';
+    subtype 'Death', as 'Int', where { $_ == 1 };
+    coerce  'Death', from 'Any', via { confess };
+}
+
+{
+    my ($attr_foo_line, $attr_bar_line, $ctor_line);
+    {
+        package Foo;
+        use Moose;
+
+        has foo => (
+            is     => 'rw',
+            isa    => 'Death',
+            coerce => 1,
+        );
+        $attr_foo_line = __LINE__ - 5;
+
+        has bar => (
+            accessor => 'baz',
+            isa      => 'Death',
+            coerce   => 1,
+        );
+        $attr_bar_line = __LINE__ - 5;
+
+        __PACKAGE__->meta->make_immutable;
+        $ctor_line = __LINE__ - 1;
+    }
+
+    like(
+        exception { Foo->new(foo => 2) },
+        qr/\Qcalled at constructor Foo::new (defined at $0 line $ctor_line)\E/,
+        "got definition context for the constructor"
+    );
+
+    like(
+        exception { my $f = Foo->new(foo => 1); $f->foo(2) },
+        qr/\Qcalled at accessor Foo::foo (defined at $0 line $attr_foo_line)\E/,
+        "got definition context for the accessor"
+    );
+
+    like(
+        exception { my $f = Foo->new(foo => 1); $f->baz(2) },
+        qr/\Qcalled at accessor Foo::baz of attribute bar (defined at $0 line $attr_bar_line)\E/,
+        "got definition context for the accessor"
+    );
+}
+
+{
+    my ($dtor_line);
+    {
+        package Bar;
+        use Moose;
+
+        # just dying here won't work, because perl's exception handling is
+        # terrible
+        sub DEMOLISH { try { confess } catch { warn $_ } }
+
+        __PACKAGE__->meta->make_immutable;
+        $dtor_line = __LINE__ - 1;
+    }
+
+    {
+        my $warning = '';
+        local $SIG{__WARN__} = sub { $warning .= $_[0] };
+        { Bar->new }
+        like(
+            $warning,
+            qr/\Qcalled at destructor Bar::DESTROY (defined at $0 line $dtor_line)\E/,
+            "got definition context for the destructor"
+        );
+    }
+}
+
+done_testing;
diff --git a/t/immutable/immutable_constructor_error.t b/t/immutable/immutable_constructor_error.t
new file mode 100644
index 0000000..cb22171
--- /dev/null
+++ b/t/immutable/immutable_constructor_error.t
@@ -0,0 +1,30 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+
+=pod
+
+This tests to make sure that we provide the same error messages from
+an immutable constructor as is provided by a non-immutable
+constructor.
+
+=cut
+
+{
+    package Foo;
+    use Moose;
+
+    has 'foo' => (is => 'rw', isa => 'Int');
+
+    Foo->meta->make_immutable(debug => 0);
+}
+
+my $scalar = 1;
+like( exception { Foo->new($scalar) }, qr/\QSingle parameters to new() must be a HASH ref/, 'Non-ref provided to immutable constructor gives useful error message' );
+like( exception { Foo->new(\$scalar) }, qr/\QSingle parameters to new() must be a HASH ref/, 'Scalar ref provided to immutable constructor gives useful error message' );
+like( exception { Foo->new(undef) }, qr/\QSingle parameters to new() must be a HASH ref/, 'undef provided to immutable constructor gives useful error message' );
+
+done_testing;
diff --git a/t/immutable/immutable_destroy.t b/t/immutable/immutable_destroy.t
new file mode 100644
index 0000000..8dfc3d3
--- /dev/null
+++ b/t/immutable/immutable_destroy.t
@@ -0,0 +1,21 @@
+use strict;
+use warnings;
+use Test::More;
+
+{
+    package FooBar;
+    use Moose;
+
+    has 'name' => ( is => 'ro' );
+
+    sub DESTROY { shift->name }
+
+    local $SIG{__WARN__} = sub {};
+    __PACKAGE__->meta->make_immutable;
+}
+
+my $f = FooBar->new( name => 'SUSAN' );
+
+is( $f->DESTROY, 'SUSAN', 'Did moose overload DESTROY?' );
+
+done_testing;
diff --git a/t/immutable/immutable_meta_class.t b/t/immutable/immutable_meta_class.t
new file mode 100644
index 0000000..3c52d92
--- /dev/null
+++ b/t/immutable/immutable_meta_class.t
@@ -0,0 +1,25 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+
+{
+    package My::Meta;
+
+    use Moose;
+
+    extends 'Moose::Meta::Class';
+
+    has 'meta_size' => (
+        is  => 'rw',
+        isa => 'Int',
+    );
+}
+
+is( exception {
+    My::Meta->meta()->make_immutable(debug => 0)
+}, undef, '... can make a meta class immutable' );
+
+done_testing;
diff --git a/t/immutable/immutable_metaclass_with_traits.t b/t/immutable/immutable_metaclass_with_traits.t
new file mode 100644
index 0000000..466a7c0
--- /dev/null
+++ b/t/immutable/immutable_metaclass_with_traits.t
@@ -0,0 +1,36 @@
+use strict;
+use warnings;
+use Test::More;
+
+{
+    package FooTrait;
+    use Moose::Role;
+}
+{
+    package Foo;
+    use Moose -traits => ['FooTrait'];
+}
+
+is(Class::MOP::class_of('Foo'), Foo->meta,
+    "class_of and ->meta are the same on Foo");
+my $meta = Foo->meta;
+is(Class::MOP::class_of($meta), $meta->meta,
+    "class_of and ->meta are the same on Foo's metaclass");
+isa_ok(Class::MOP::class_of($meta), 'Moose::Meta::Class');
+isa_ok($meta->meta, 'Moose::Meta::Class');
+ok($meta->is_mutable, "class is mutable");
+ok(Class::MOP::class_of($meta)->is_mutable, "metaclass is mutable");
+ok($meta->meta->does_role('FooTrait'), "does the trait");
+Foo->meta->make_immutable;
+is(Class::MOP::class_of('Foo'), Foo->meta,
+    "class_of and ->meta are the same on Foo (immutable)");
+$meta = Foo->meta;
+isa_ok($meta->meta, 'Moose::Meta::Class');
+ok($meta->is_immutable, "class is immutable");
+ok($meta->meta->is_immutable, "metaclass is immutable (immutable class)");
+is(Class::MOP::class_of($meta), $meta->meta,
+    "class_of and ->meta are the same on Foo's metaclass (immutable)");
+isa_ok(Class::MOP::class_of($meta), 'Moose::Meta::Class');
+ok($meta->meta->does_role('FooTrait'), "still does the trait after immutable");
+
+done_testing;
diff --git a/t/immutable/immutable_moose.t b/t/immutable/immutable_moose.t
new file mode 100644
index 0000000..d77ea37
--- /dev/null
+++ b/t/immutable/immutable_moose.t
@@ -0,0 +1,84 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+use Moose::Meta::Role;
+
+
+{
+    package FooRole;
+    our $VERSION = '0.01';
+    sub foo {'FooRole::foo'}
+}
+
+{
+    package Foo;
+    use Moose;
+
+    #two checks because the inlined methods are different when
+    #there is a TC present.
+    has 'foos' => ( is => 'ro', lazy_build => 1 );
+    has 'bars' => ( isa => 'Str', is => 'ro', lazy_build => 1 );
+    has 'bazes' => ( isa => 'Str', is => 'ro', builder => '_build_bazes' );
+    sub _build_foos  {"many foos"}
+    sub _build_bars  {"many bars"}
+    sub _build_bazes {"many bazes"}
+}
+
+{
+    my $foo_role = Moose::Meta::Role->initialize('FooRole');
+    my $meta     = Foo->meta;
+
+    is( exception { Foo->new }, undef, "lazy_build works" );
+    is( Foo->new->foos, 'many foos',
+        "correct value for 'foos'  before inlining constructor" );
+    is( Foo->new->bars, 'many bars',
+        "correct value for 'bars'  before inlining constructor" );
+    is( Foo->new->bazes, 'many bazes',
+        "correct value for 'bazes' before inlining constructor" );
+    is( exception { $meta->make_immutable }, undef, "Foo is imutable" );
+    is( exception { $meta->identifier }, undef, "->identifier on metaclass lives" );
+    isnt( exception { $meta->add_role($foo_role) }, undef, "Add Role is locked" );
+    is( exception { Foo->new }, undef, "Inlined constructor works with lazy_build" );
+    is( Foo->new->foos, 'many foos',
+        "correct value for 'foos'  after inlining constructor" );
+    is( Foo->new->bars, 'many bars',
+        "correct value for 'bars'  after inlining constructor" );
+    is( Foo->new->bazes, 'many bazes',
+        "correct value for 'bazes' after inlining constructor" );
+    is( exception { $meta->make_mutable }, undef, "Foo is mutable" );
+    is( exception { $meta->add_role($foo_role) }, undef, "Add Role is unlocked" );
+
+}
+
+{
+  package Bar;
+
+  use Moose;
+
+  sub BUILD { 'bar' }
+}
+
+{
+  package Baz;
+
+  use Moose;
+
+  extends 'Bar';
+
+  sub BUILD { 'baz' }
+}
+
+is( exception { Bar->meta->make_immutable }, undef, 'Immutable meta with single BUILD' );
+
+is( exception { Baz->meta->make_immutable }, undef, 'Immutable meta with multiple BUILDs' );
+
+=pod
+
+Nothing here yet, but soon :)
+
+=cut
+
+done_testing;
diff --git a/t/immutable/immutable_roundtrip.t b/t/immutable/immutable_roundtrip.t
new file mode 100644
index 0000000..2f1bceb
--- /dev/null
+++ b/t/immutable/immutable_roundtrip.t
@@ -0,0 +1,33 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Requires 'Test::Output';  # skip all if not installed
+
+{
+    package Foo;
+    use Moose;
+    __PACKAGE__->meta->make_immutable;
+}
+
+{
+    package Bar;
+    use Moose;
+
+    extends 'Foo';
+
+    __PACKAGE__->meta->make_immutable;
+    __PACKAGE__->meta->make_mutable;
+
+
+    # This actually is testing for a bug in Class::MOP that cause
+    # Moose::Meta::Method::Constructor to spit out a warning when it
+    # shouldn't have done so. The bug was fixed in CMOP 0.75.
+    ::stderr_unlike(
+        sub { Bar->meta->make_immutable },
+        qr/Not inlining a constructor/,
+        'no warning that Bar may not have an inlined constructor'
+    );
+}
+
+done_testing;
diff --git a/t/immutable/immutable_trigger_from_constructor.t b/t/immutable/immutable_trigger_from_constructor.t
new file mode 100644
index 0000000..799cecc
--- /dev/null
+++ b/t/immutable/immutable_trigger_from_constructor.t
@@ -0,0 +1,36 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+
+{
+    package AClass;
+
+    use Moose;
+
+    has 'foo' => (is => 'rw', isa => 'Maybe[Str]', trigger => sub {
+        die "Pulling the Foo trigger\n"
+    });
+
+    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);
+
+    no Moose;
+}
+
+eval { AClass->new(foo => 'bar') };
+like ($@, qr/^Pulling the Foo trigger/, "trigger from immutable constructor");
+
+eval { AClass->new(baz => 'bar') };
+like ($@, qr/^Pulling the Baz trigger/, "trigger from immutable constructor");
+
+is( exception { AClass->new(bar => 'bar') }, undef, '... no triggers called' );
+
+done_testing;
diff --git a/t/immutable/inline_close_over.t b/t/immutable/inline_close_over.t
new file mode 100644
index 0000000..3b01504
--- /dev/null
+++ b/t/immutable/inline_close_over.t
@@ -0,0 +1,361 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Requires qw(Data::Visitor PadWalker);
+
+use Class::Load 'load_class';
+use Try::Tiny;
+
+my $can_partialdump = try {
+    load_class('Devel::PartialDump', { -version => 0.14 }); 1;
+};
+
+{
+    package Test::Visitor;
+    use Moose;
+    use Moose::Util::TypeConstraints;
+    extends 'Data::Visitor';
+
+    has closed_over => (
+        traits  => ['Array'],
+        isa     => 'ArrayRef',
+        default => sub { [] },
+        handles => {
+            add_closed_over => 'push',
+            closed_over     => 'elements',
+            pass            => 'is_empty',
+        },
+    );
+
+    before visit_code => sub {
+        my $self = shift;
+        my ($code) = @_;
+        my $closed_over = PadWalker::closed_over($code);
+        $self->visit_ref($closed_over);
+    };
+
+    after visit => sub {
+        my $self = shift;
+        my ($thing) = @_;
+
+        $self->add_closed_over($thing)
+            unless $self->_is_okay_to_close_over($thing);
+    };
+
+    sub _is_okay_to_close_over {
+        my $self = shift;
+        my ($thing) = @_;
+
+        match_on_type $thing => (
+            'RegexpRef'  => sub { 1 },
+            'Object'     => sub { 0 },
+            'GlobRef'    => sub { 0 },
+            'FileHandle' => sub { 0 },
+            'Any'        => sub { 1 },
+        );
+    }
+}
+
+sub close_over_ok {
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+    my ($package, $method) = @_;
+    my $visitor = Test::Visitor->new;
+    my $code = $package->meta->find_method_by_name($method)->body;
+    $visitor->visit($code);
+    if ($visitor->pass) {
+        pass("${package}::${method} didn't close over anything complicated");
+    }
+    else {
+        fail("${package}::${method} closed over some stuff:");
+        my @closed_over = $visitor->closed_over;
+        for my $i (1..10) {
+            last unless @closed_over;
+            my $closed_over = shift @closed_over;
+            if ($can_partialdump) {
+                $closed_over = Devel::PartialDump->new->dump($closed_over);
+            }
+            diag($closed_over);
+        }
+        diag("... and " . scalar(@closed_over) . " more")
+            if @closed_over;
+    }
+}
+
+{
+    package Foo;
+    use Moose;
+    use Moose::Util::TypeConstraints;
+
+    has foo => (
+        is  => 'ro',
+        isa => 'Str',
+    );
+
+    has bar => (
+        is      => 'ro',
+        isa     => 'Int',
+        default => 1,
+    );
+
+    has baz => (
+        is      => 'rw',
+        isa     => 'ArrayRef[Num]',
+        default => sub { [ 1.2 ] },
+        trigger => sub { warn "blah" },
+    );
+
+    subtype 'Thing',
+         as 'Int',
+         where { $_ < 5 },
+         message { "must be less than 5" };
+    has quux => (
+        is        => 'rw',
+        isa       => 'Thing',
+        predicate => 'has_quux',
+        clearer   => 'clear_quux',
+    );
+
+    __PACKAGE__->meta->make_immutable;
+}
+
+close_over_ok('Foo', $_) for qw(new foo bar baz quux has_quux clear_quux);
+
+{
+    package Foo::Sub;
+    use Moose;
+    extends 'Foo';
+
+    around foo => sub {
+        my $orig = shift;
+        my $self = shift;
+        $self->$orig(@_);
+    };
+
+    after bar => sub { };
+    before baz => sub { };
+    override quux => sub { super };
+
+    sub blah { inner }
+
+    __PACKAGE__->meta->make_immutable;
+}
+
+close_over_ok('Foo::Sub', $_) for qw(new foo bar baz quux blah);
+
+{
+    package Foo::Sub::Sub;
+    use Moose;
+    extends 'Foo::Sub';
+
+    augment blah => { inner };
+
+    __PACKAGE__->meta->make_immutable;
+}
+
+close_over_ok('Foo::Sub::Sub', $_) for qw(new blah);
+
+{
+    my %handles = (
+        Array   => {
+            count                 => 'count',
+            elements              => 'elements',
+            is_empty              => 'is_empty',
+            push                  => 'push',
+            push_curried          => [ push => 42, 84 ],
+            unshift               => 'unshift',
+            unshift_curried       => [ unshift => 42, 84 ],
+            pop                   => 'pop',
+            shift                 => 'shift',
+            get                   => 'get',
+            get_curried           => [ get => 1 ],
+            set                   => 'set',
+            set_curried_1         => [ set => 1 ],
+            set_curried_2         => [ set => ( 1, 98 ) ],
+            accessor              => 'accessor',
+            accessor_curried_1    => [ accessor => 1 ],
+            accessor_curried_2    => [ accessor => ( 1, 90 ) ],
+            clear                 => 'clear',
+            delete                => 'delete',
+            delete_curried        => [ delete => 1 ],
+            insert                => 'insert',
+            insert_curried        => [ insert => ( 1, 101 ) ],
+            splice                => 'splice',
+            splice_curried_1      => [ splice => 1 ],
+            splice_curried_2      => [ splice => 1, 2 ],
+            splice_curried_all    => [ splice => 1, 2, ( 3, 4, 5 ) ],
+            sort                  => 'sort',
+            sort_curried          => [ sort => ( sub { $_[1] <=> $_[0] } ) ],
+            sort_in_place         => 'sort_in_place',
+            sort_in_place_curried =>
+                [ sort_in_place => ( sub { $_[1] <=> $_[0] } ) ],
+            map                   => 'map',
+            map_curried           => [ map => ( sub { $_ + 1 } ) ],
+            grep                  => 'grep',
+            grep_curried          => [ grep => ( sub { $_ < 5 } ) ],
+            first                 => 'first',
+            first_curried         => [ first => ( sub { $_ % 2 } ) ],
+            join                  => 'join',
+            join_curried          => [ join => '-' ],
+            shuffle               => 'shuffle',
+            uniq                  => 'uniq',
+            reduce                => 'reduce',
+            reduce_curried        => [ reduce => ( sub { $_[0] * $_[1] } ) ],
+            natatime              => 'natatime',
+            natatime_curried      => [ natatime => 2 ],
+        },
+        Hash    => {
+            option_accessor  => 'accessor',
+            quantity         => [ accessor => 'quantity' ],
+            clear_options    => 'clear',
+            num_options      => 'count',
+            delete_option    => 'delete',
+            is_defined       => 'defined',
+            options_elements => 'elements',
+            has_option       => 'exists',
+            get_option       => 'get',
+            has_no_options   => 'is_empty',
+            keys             => 'keys',
+            values           => 'values',
+            key_value        => 'kv',
+            set_option       => 'set',
+        },
+        Counter => {
+            inc_counter    => 'inc',
+            inc_counter_2  => [ inc => 2 ],
+            dec_counter    => 'dec',
+            dec_counter_2  => [ dec => 2 ],
+            reset_counter  => 'reset',
+            set_counter    => 'set',
+            set_counter_42 => [ set => 42 ],
+        },
+        Number  => {
+            abs         => 'abs',
+            add         => 'add',
+            inc         => [ add => 1 ],
+            div         => 'div',
+            cut_in_half => [ div => 2 ],
+            mod         => 'mod',
+            odd         => [ mod => 2 ],
+            mul         => 'mul',
+            set         => 'set',
+            sub         => 'sub',
+            dec         => [ sub => 1 ],
+        },
+        Bool    => {
+            illuminate  => 'set',
+            darken      => 'unset',
+            flip_switch => 'toggle',
+            is_dark     => 'not',
+        },
+        String  => {
+            inc              => 'inc',
+            append           => 'append',
+            append_curried   => [ append => '!' ],
+            prepend          => 'prepend',
+            prepend_curried  => [ prepend => '-' ],
+            replace          => 'replace',
+            replace_curried  => [ replace => qr/(.)$/, sub { uc $1 } ],
+            chop             => 'chop',
+            chomp            => 'chomp',
+            clear            => 'clear',
+            match            => 'match',
+            match_curried    => [ match  => qr/\D/ ],
+            length           => 'length',
+            substr           => 'substr',
+            substr_curried_1 => [ substr => (1) ],
+            substr_curried_2 => [ substr => ( 1, 3 ) ],
+            substr_curried_3 => [ substr => ( 1, 3, 'ong' ) ],
+        },
+        Code    => {
+            execute        => 'execute',
+            execute_method => 'execute_method',
+        },
+    );
+
+    my %isa = (
+        Array   => 'ArrayRef[Str]',
+        Hash    => 'HashRef[Int]',
+        Counter => 'Int',
+        Number  => 'Num',
+        Bool    => 'Bool',
+        String  => 'Str',
+        Code    => 'CodeRef',
+    );
+
+    my %default = (
+        Array   => [],
+        Hash    => {},
+        Counter => 0,
+        Number  => 0.0,
+        Bool    => 1,
+        String  => '',
+        Code    => sub { },
+    );
+
+    for my $trait (keys %default) {
+        my $class_name = "Native::$trait";
+        my $handles = $handles{$trait};
+        my $attr_class = Moose::Util::with_traits(
+            'Moose::Meta::Attribute',
+            "Moose::Meta::Attribute::Native::Trait::$trait",
+        );
+        Moose::Meta::Class->create(
+            $class_name,
+            superclasses => ['Moose::Object'],
+            attributes   => [
+                $attr_class->new(
+                    'nonlazy',
+                    is      => 'ro',
+                    isa     => $isa{$trait},
+                    default => sub { $default{$trait} },
+                    handles => {
+                        map {; "nonlazy_$_" => $handles->{$_} } keys %$handles
+                    },
+                ),
+                $attr_class->new(
+                    'lazy',
+                    is      => 'ro',
+                    isa     => $isa{$trait},
+                    lazy    => 1,
+                    default => sub { $default{$trait} },
+                    handles => {
+                        map {; "lazy_$_" => $handles->{$_} } keys %$handles
+                    },
+                ),
+            ],
+        );
+        close_over_ok($class_name, $_) for (
+            'new',
+            map {; "nonlazy_$_", "lazy_$_" } keys %$handles
+        );
+    }
+}
+
+{
+    package WithInitializer;
+    use Moose;
+
+    has foo => (
+        is          => 'ro',
+        isa         => 'Str',
+        initializer => sub { },
+    );
+
+    has bar => (
+        is          => 'ro',
+        isa         => 'Str',
+        lazy        => 1,
+        default     => sub { 'a' },
+        initializer => sub { },
+    );
+
+    __PACKAGE__->meta->make_immutable;
+}
+
+close_over_ok('WithInitializer', 'foo');
+{ local $TODO = "initializer still closes over things";
+close_over_ok('WithInitializer', $_) for qw(new bar);
+}
+
+done_testing;
diff --git a/t/immutable/inline_fallbacks.t b/t/immutable/inline_fallbacks.t
new file mode 100644
index 0000000..362d60e
--- /dev/null
+++ b/t/immutable/inline_fallbacks.t
@@ -0,0 +1,70 @@
+use strict;
+use warnings;
+use Test::More;
+
+{
+    package Foo;
+    use Moose;
+    has foo => (is => 'ro');
+}
+
+{
+    package Foo::Sub;
+    use Moose;
+    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 Moose;
+    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 Moose;
+}
+
+{
+    package Bar::Sub;
+    use Moose;
+    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 Moose;
+    extends 'Bar';
+    sub DEMOLISH { $BAR++ }
+    # not making immutable, inheriting Bar's inlined destructor
+}
+
+Bar::Sub2->new;
+is($BAR, 1, 'DEMOLISH in subclass was called');
+
+done_testing;
diff --git a/t/immutable/inlined_constructors_n_types.t b/t/immutable/inlined_constructors_n_types.t
new file mode 100644
index 0000000..3df1fb0
--- /dev/null
+++ b/t/immutable/inlined_constructors_n_types.t
@@ -0,0 +1,60 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+=pod
+
+This tests to make sure that the inlined constructor
+has all the type constraints in order, even in the
+cases when there is no type constraint available, such
+as with a Class::MOP::Attribute object.
+
+=cut
+
+{
+    package Foo;
+    use Moose;
+    use Moose::Util::TypeConstraints;
+
+    coerce 'Int' => from 'Str' => via { length $_ ? $_ : 69 };
+
+    has 'foo' => (is => 'rw', isa => 'Int');
+    has 'baz' => (is => 'rw', isa => 'Int');
+    has 'zot' => (is => 'rw', isa => 'Int', init_arg => undef);
+    has 'moo' => (is => 'rw', isa => 'Int', coerce => 1, default => '', required => 1);
+    has 'boo' => (is => 'rw', isa => 'Int', coerce => 1, builder => '_build_boo', required => 1);
+
+    sub _build_boo { '' }
+
+    Foo->meta->add_attribute(
+        Class::MOP::Attribute->new(
+            'bar' => (
+                accessor => 'bar',
+            )
+        )
+    );
+}
+
+for (1..2) {
+    my $is_immutable   = Foo->meta->is_immutable;
+    my $mutable_string = $is_immutable ? 'immutable' : 'mutable';
+    is( exception {
+        my $f = Foo->new(foo => 10, bar => "Hello World", baz => 10, zot => 4);
+        is($f->moo, 69, "Type coercion works as expected on default ($mutable_string)");
+        is($f->boo, 69, "Type coercion works as expected on builder ($mutable_string)");
+    }, undef, "... this passes the constuctor correctly ($mutable_string)" );
+
+    is( exception {
+        Foo->new(foo => 10, bar => "Hello World", baz => 10, zot => "not an int");
+    }, undef, "... the constructor doesn't care about 'zot' ($mutable_string)" );
+
+    isnt( exception {
+        Foo->new(foo => "Hello World", bar => 100, baz => "Hello World");
+    }, undef, "... this fails the constuctor correctly ($mutable_string)" );
+
+    Foo->meta->make_immutable(debug => 0) unless $is_immutable;
+}
+
+done_testing;
diff --git a/t/immutable/multiple_demolish_inline.t b/t/immutable/multiple_demolish_inline.t
new file mode 100644
index 0000000..e9727ac
--- /dev/null
+++ b/t/immutable/multiple_demolish_inline.t
@@ -0,0 +1,45 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+
+{
+    package Foo;
+    use Moose;
+
+    has 'foo' => (is => 'rw', isa => 'Int');
+
+    sub DEMOLISH { }
+}
+
+{
+    package Bar;
+    use Moose;
+
+    extends qw(Foo);
+    has 'bar' => (is => 'rw', isa => 'Int');
+
+    sub DEMOLISH { }
+}
+
+is( exception {
+    Bar->new();
+}, undef, 'Bar->new()' );
+
+is( exception {
+    Bar->meta->make_immutable;
+}, undef, 'Bar->meta->make_immutable' );
+
+is( Bar->meta->get_method('DESTROY')->package_name, 'Bar',
+    'Bar has a DESTROY method in the Bar class (not inherited)' );
+
+is( exception {
+    Foo->meta->make_immutable;
+}, undef, 'Foo->meta->make_immutable' );
+
+is( Foo->meta->get_method('DESTROY')->package_name, 'Foo',
+    'Foo has a DESTROY method in the Bar class (not inherited)' );
+
+done_testing;