Moose-2.1405HEADMoose-2.1405master

26 files changed, 1681 insertions, 0 deletions

diff --git a/t/basics/always_strict_warnings.t b/t/basics/always_strict_warnings.t
new file mode 100644
index 0000000..ca62682
--- /dev/null
+++ b/t/basics/always_strict_warnings.t
@@ -0,0 +1,71 @@
+use Test::More;
+
+# very intentionally not doing use strict; use warnings here...
+
+# for classes ...
+{
+    package Foo;
+    use Moose;
+
+    eval '$foo = 5;';
+    ::ok($@, '... got an error because strict is on');
+    ::like($@, qr/Global symbol \"\$foo\" requires explicit package name /, '... got the right error');
+
+    {
+        my $warn;
+        local $SIG{__WARN__} = sub { $warn = $_[0] };
+
+        ::ok(!$warn, '... no warning yet');
+
+        eval 'my $bar = 1 + "hello"';
+
+        ::ok($warn, '... got a warning');
+        ::like($warn, qr/Argument \"hello\" isn\'t numeric in addition \(\+\)/, '.. and it is the right warning');
+    }
+}
+
+# and for roles ...
+{
+    package Bar;
+    use Moose::Role;
+
+    eval '$foo = 5;';
+    ::ok($@, '... got an error because strict is on');
+    ::like($@, qr/Global symbol \"\$foo\" requires explicit package name /, '... got the right error');
+
+    {
+        my $warn;
+        local $SIG{__WARN__} = sub { $warn = $_[0] };
+
+        ::ok(!$warn, '... no warning yet');
+
+        eval 'my $bar = 1 + "hello"';
+
+        ::ok($warn, '... got a warning');
+        ::like($warn, qr/Argument \"hello\" isn\'t numeric in addition \(\+\)/, '.. and it is the right warning');
+    }
+}
+
+# and for exporters
+{
+    package Bar;
+    use Moose::Exporter;
+
+    eval '$foo = 5;';
+    ::ok($@, '... got an error because strict is on');
+    ::like($@, qr/Global symbol \"\$foo\" requires explicit package name /, '... got the right error');
+
+    {
+        my $warn;
+        local $SIG{__WARN__} = sub { $warn = $_[0] };
+
+        ::ok(!$warn, '... no warning yet');
+
+        eval 'my $bar = 1 + "hello"';
+
+        ::ok($warn, '... got a warning');
+        ::like($warn, qr/Argument \"hello\" isn\'t numeric in addition \(\+\)/, '.. and it is the right warning');
+    }
+}
+
+done_testing;
diff --git a/t/basics/basic_class_setup.t b/t/basics/basic_class_setup.t
new file mode 100644
index 0000000..64a5779
--- /dev/null
+++ b/t/basics/basic_class_setup.t
@@ -0,0 +1,50 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+
+{
+    package Foo;
+    use Moose;
+    use Moose::Util::TypeConstraints;
+}
+
+can_ok('Foo', 'meta');
+isa_ok(Foo->meta, 'Moose::Meta::Class');
+
+ok(Foo->meta->has_method('meta'), '... we got the &meta method');
+ok(Foo->isa('Moose::Object'), '... Foo is automagically a Moose::Object');
+
+isnt( exception {
+   Foo->meta->has_method()
+}, undef, '... has_method requires an arg' );
+
+can_ok('Foo', 'does');
+
+foreach my $function (qw(
+                         extends
+                         has
+                         before after around
+                         blessed confess
+                         type subtype as where
+                         coerce from via
+                         find_type_constraint
+                         )) {
+    ok(!Foo->meta->has_method($function), '... the meta does not treat "' . $function . '" as a method');
+}
+
+foreach my $import (qw(
+    blessed
+    try
+    catch
+    in_global_destruction
+)) {
+    ok(!Moose::Object->can($import), "no namespace pollution in Moose::Object ($import)" );
+
+    local $TODO = $import eq 'blessed' ? "no automatic namespace cleaning yet" : undef;
+    ok(!Foo->can($import), "no namespace pollution in Moose::Object ($import)" );
+}
+
+done_testing;
diff --git a/t/basics/buildargs.t b/t/basics/buildargs.t
new file mode 100644
index 0000000..f7b5b5d
--- /dev/null
+++ b/t/basics/buildargs.t
@@ -0,0 +1,41 @@
+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 Bar;
+    use Moose;
+
+    extends qw(Foo);
+}
+
+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/basics/buildargs_warning.t b/t/basics/buildargs_warning.t
new file mode 100644
index 0000000..5b1a415
--- /dev/null
+++ b/t/basics/buildargs_warning.t
@@ -0,0 +1,32 @@
+use strict;
+use warnings;
+
+use Test::Fatal;
+use Test::More;
+use Test::Moose qw( with_immutable );
+
+use Test::Requires 'Test::Output';
+
+{
+    package Baz;
+    use Moose;
+}
+
+with_immutable {
+    is( exception {
+        stderr_like { Baz->new( x => 42, 'y' ) }
+        qr{\QThe new() method for Baz expects a hash reference or a key/value list. You passed an odd number of arguments at $0 line \E\d+},
+            'warning when passing an odd number of args to new()';
+
+        stderr_unlike { Baz->new( x => 42, 'y' ) }
+        qr{\QOdd number of elements in anonymous hash},
+            'we suppress the standard warning from Perl for an odd number of elements in a hash';
+
+        stderr_is { Baz->new( { x => 42 } ) }
+        q{},
+            'we handle a single hashref to new without errors';
+    }, undef );
+}
+'Baz';
+
+done_testing;
diff --git a/t/basics/create.t b/t/basics/create.t
new file mode 100644
index 0000000..37dcf57
--- /dev/null
+++ b/t/basics/create.t
@@ -0,0 +1,61 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+use Class::Load 'is_class_loaded';
+
+{
+    package Class;
+    use Moose;
+
+    package Foo;
+    use Moose::Role;
+    sub foo_role_applied { 1 }
+
+    package Conflicts::With::Foo;
+    use Moose::Role;
+    sub foo_role_applied { 0 }
+
+    package Not::A::Role;
+    sub lol_wut { 42 }
+}
+
+my $new_class;
+
+is( exception {
+    $new_class = Moose::Meta::Class->create(
+        'Class::WithFoo',
+        superclasses => ['Class'],
+        roles        => ['Foo'],
+    );
+}, undef, 'creating lives' );
+ok $new_class;
+
+my $with_foo = Class::WithFoo->new;
+
+ok $with_foo->foo_role_applied;
+isa_ok $with_foo, 'Class', '$with_foo';
+
+like( exception {
+    Moose::Meta::Class->create(
+        'Made::Of::Fail',
+        superclasses => ['Class'],
+        roles => 'Foo', # "oops"
+    );
+}, qr/You must pass an ARRAY ref of roles/ );
+
+ok !is_class_loaded('Made::Of::Fail'), "did not create Made::Of::Fail";
+
+isnt( exception {
+    Moose::Meta::Class->create(
+        'Continuing::To::Fail',
+        superclasses => ['Class'],
+        roles        => ['Foo', 'Conflicts::With::Foo'],
+    );
+}, undef, 'conflicting roles == death' );
+
+# XXX: Continuing::To::Fail gets created anyway
+
+done_testing;
diff --git a/t/basics/create_anon.t b/t/basics/create_anon.t
new file mode 100644
index 0000000..b36b2a8
--- /dev/null
+++ b/t/basics/create_anon.t
@@ -0,0 +1,125 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use Moose::Meta::Class;
+
+{
+    package Class;
+    use Moose;
+
+    package Foo;
+    use Moose::Role;
+    sub foo_role_applied { 1 }
+
+    package Bar;
+    use Moose::Role;
+    sub bar_role_applied { 1 }
+}
+
+# try without caching first
+
+{
+    my $class_and_foo_1 = Moose::Meta::Class->create_anon_class(
+        superclasses => ['Class'],
+        roles        => ['Foo'],
+    );
+
+    my $class_and_foo_2 = Moose::Meta::Class->create_anon_class(
+        superclasses => ['Class'],
+        roles        => ['Foo'],
+    );
+
+    isnt $class_and_foo_1->name, $class_and_foo_2->name,
+      'creating the same class twice without caching results in 2 classes';
+
+    map { ok $_->name->foo_role_applied } ($class_and_foo_1, $class_and_foo_2);
+}
+
+# now try with caching
+
+{
+    my $class_and_foo_1 = Moose::Meta::Class->create_anon_class(
+        superclasses => ['Class'],
+        roles        => ['Foo'],
+        cache        => 1,
+    );
+
+    my $class_and_foo_2 = Moose::Meta::Class->create_anon_class(
+        superclasses => ['Class'],
+        roles        => ['Foo'],
+        cache        => 1,
+    );
+
+    is $class_and_foo_1->name, $class_and_foo_2->name,
+      'with cache, the same class is the same class';
+
+    map { ok $_->name->foo_role_applied } ($class_and_foo_1, $class_and_foo_2);
+
+    my $class_and_bar = Moose::Meta::Class->create_anon_class(
+        superclasses => ['Class'],
+        roles        => ['Bar'],
+        cache        => 1,
+    );
+
+    isnt $class_and_foo_1->name, $class_and_bar,
+      'class_and_foo and class_and_bar are different';
+
+    ok $class_and_bar->name->bar_role_applied;
+}
+
+# This tests that a cached metaclass can be reinitialized and still retain its
+# metaclass object.
+{
+    my $name = Moose::Meta::Class->create_anon_class(
+        superclasses => ['Class'],
+        cache        => 1,
+    )->name;
+
+    $name->meta->reinitialize( $name );
+
+    can_ok( $name, 'meta' );
+}
+
+{
+    my $name;
+    {
+        my $meta = Moose::Meta::Class->create_anon_class(
+            superclasses => ['Class'],
+            cache        => 1,
+        );
+        $name = $meta->name;
+        ok(!Class::MOP::metaclass_is_weak($name), "cache implies weaken => 0");
+    }
+    ok(Class::MOP::class_of($name), "cache implies weaken => 0");
+    Class::MOP::remove_metaclass_by_name($name);
+}
+
+{
+    my $name;
+    {
+        my $meta = Moose::Meta::Class->create_anon_class(
+            superclasses => ['Class'],
+            cache        => 1,
+            weaken       => 1,
+        );
+        my $name = $meta->name;
+        ok(Class::MOP::metaclass_is_weak($name), "but we can override this");
+    }
+    ok(!Class::MOP::class_of($name), "but we can override this");
+}
+
+{
+    my $meta = Moose::Meta::Class->create_anon_class(
+        superclasses => ['Class'],
+        cache        => 1,
+    );
+    ok(!Class::MOP::metaclass_is_weak($meta->name),
+       "creates a nonweak metaclass");
+    Scalar::Util::weaken($meta);
+    Class::MOP::remove_metaclass_by_name($meta->name);
+    ok(!$meta, "removing a cached anon class means it's actually gone");
+}
+
+done_testing;
diff --git a/t/basics/deprecations.t b/t/basics/deprecations.t
new file mode 100644
index 0000000..1eb7a9c
--- /dev/null
+++ b/t/basics/deprecations.t
@@ -0,0 +1,23 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use Moose ();
+use Moose::Util::TypeConstraints;
+
+{
+    my $warnings;
+    local $SIG{__WARN__} = sub { $warnings .= $_[0] };
+    enum Foo => qw(Bar Baz Quux);
+    like($warnings, qr/Passing a list of values to enum is deprecated\. Enum values should be wrapped in an arrayref\./);
+}
+
+{
+    my $warnings;
+    local $SIG{__WARN__} = sub { $warnings .= $_[0] };
+    duck_type Bar => qw(baz quux);
+    like($warnings, qr/Passing a list of values to duck_type is deprecated\. The method names should be wrapped in an arrayref\./);
+}
+
+done_testing;
diff --git a/t/basics/destruction.t b/t/basics/destruction.t
new file mode 100644
index 0000000..55cb78e
--- /dev/null
+++ b/t/basics/destruction.t
@@ -0,0 +1,51 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+our @demolished;
+package Foo;
+use Moose;
+
+sub DEMOLISH {
+    my $self = shift;
+    push @::demolished, __PACKAGE__;
+}
+
+package Foo::Sub;
+use Moose;
+extends 'Foo';
+
+sub DEMOLISH {
+    my $self = shift;
+    push @::demolished, __PACKAGE__;
+}
+
+package Foo::Sub::Sub;
+use Moose;
+extends 'Foo::Sub';
+
+sub DEMOLISH {
+    my $self = shift;
+    push @::demolished, __PACKAGE__;
+}
+
+package main;
+{
+    my $foo = Foo->new;
+}
+is_deeply(\@demolished, ['Foo'], "Foo demolished properly");
+@demolished = ();
+{
+    my $foo_sub = Foo::Sub->new;
+}
+is_deeply(\@demolished, ['Foo::Sub', 'Foo'], "Foo::Sub demolished properly");
+@demolished = ();
+{
+    my $foo_sub_sub = Foo::Sub::Sub->new;
+}
+is_deeply(\@demolished, ['Foo::Sub::Sub', 'Foo::Sub', 'Foo'],
+          "Foo::Sub::Sub demolished properly");
+@demolished = ();
+
+done_testing;
diff --git a/t/basics/error_handling.t b/t/basics/error_handling.t
new file mode 100644
index 0000000..250aa30
--- /dev/null
+++ b/t/basics/error_handling.t
@@ -0,0 +1,19 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+# This tests the error handling in Moose::Object only
+
+{
+    package Foo;
+    use Moose;
+}
+
+like( exception { Foo->new('bad') }, qr/^\QSingle parameters to new() must be a HASH ref/, 'A single non-hashref arg to a constructor throws an error' );
+like( exception { Foo->new(undef) }, qr/^\QSingle parameters to new() must be a HASH ref/, 'A single non-hashref arg to a constructor throws an error' );
+
+like( exception { Foo->does() }, qr/^\QYou must supply a role name to does()/, 'Cannot call does() without a role name' );
+
+done_testing;
diff --git a/t/basics/global-destruction-helper.pl b/t/basics/global-destruction-helper.pl
new file mode 100644
index 0000000..a5b75c6
--- /dev/null
+++ b/t/basics/global-destruction-helper.pl
@@ -0,0 +1,34 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+
+{
+    package Foo;
+    use Moose;
+
+    sub DEMOLISH {
+        my $self = shift;
+        my ($igd) = @_;
+
+        print $igd;
+    }
+}
+
+{
+    package Bar;
+    use Moose;
+
+    sub DEMOLISH {
+        my $self = shift;
+        my ($igd) = @_;
+
+        print $igd;
+    }
+
+    __PACKAGE__->meta->make_immutable;
+}
+
+our $foo = Foo->new;
+our $bar = Bar->new;
diff --git a/t/basics/global_destruction.t b/t/basics/global_destruction.t
new file mode 100644
index 0000000..53a4db1
--- /dev/null
+++ b/t/basics/global_destruction.t
@@ -0,0 +1,49 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+{
+    package Foo;
+    use Moose;
+
+    sub DEMOLISH {
+        my $self = shift;
+        my ($igd) = @_;
+        ::ok(
+            !$igd,
+            'in_global_destruction state is passed to DEMOLISH properly (false)'
+        );
+    }
+}
+
+{
+    my $foo = Foo->new;
+}
+
+{
+    package Bar;
+    use Moose;
+
+    sub DEMOLISH {
+        my $self = shift;
+        my ($igd) = @_;
+        ::ok(
+            !$igd,
+            'in_global_destruction state is passed to DEMOLISH properly (false)'
+        );
+    }
+
+    __PACKAGE__->meta->make_immutable;
+}
+
+{
+    my $bar = Bar->new;
+}
+
+ok(
+    $_,
+    'in_global_destruction state is passed to DEMOLISH properly (true)'
+) for split //, `$^X t/basics/global-destruction-helper.pl`;
+
+done_testing;
diff --git a/t/basics/import_unimport.t b/t/basics/import_unimport.t
new file mode 100644
index 0000000..b44fea7
--- /dev/null
+++ b/t/basics/import_unimport.t
@@ -0,0 +1,98 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+
+my @moose_exports = qw(
+    extends with
+    has
+    before after around
+    override
+    augment
+    super inner
+    blessed confess
+);
+
+{
+    package Foo;
+
+    eval 'use Moose';
+    die $@ if $@;
+}
+
+can_ok('Foo', $_) for @moose_exports;
+
+{
+    package Foo;
+
+    eval 'no Moose';
+    die $@ if $@;
+}
+
+ok(!Foo->can($_), '... Foo can no longer do ' . $_) for @moose_exports;
+
+# and check the type constraints as well
+
+my @moose_type_constraint_exports = qw(
+    type subtype as where message
+    coerce from via
+    enum
+    find_type_constraint
+);
+
+{
+    package Bar;
+
+    eval 'use Moose::Util::TypeConstraints';
+    die $@ if $@;
+}
+
+can_ok('Bar', $_) for @moose_type_constraint_exports;
+
+{
+    package Bar;
+
+    eval 'no Moose::Util::TypeConstraints';
+    die $@ if $@;
+}
+
+ok(!Bar->can($_), '... Bar can no longer do ' . $_) for @moose_type_constraint_exports;
+
+
+{
+    package Baz;
+
+    use Moose;
+    use Scalar::Util qw( blessed );
+
+    no Moose;
+}
+
+can_ok( 'Baz', 'blessed' );
+
+{
+    package Moo;
+
+    use Scalar::Util qw( blessed );
+    use Moose;
+
+    no Moose;
+}
+
+can_ok( 'Moo', 'blessed' );
+
+my $blessed;
+{
+    package Quux;
+
+    use Scalar::Util qw( blessed );
+    use Moose blessed => { -as => \$blessed };
+
+    no Moose;
+}
+
+can_ok( 'Quux', 'blessed' );
+is( $blessed, \&Scalar::Util::blessed );
+
+done_testing;
diff --git a/t/basics/inner_and_augment.t b/t/basics/inner_and_augment.t
new file mode 100644
index 0000000..c343c38
--- /dev/null
+++ b/t/basics/inner_and_augment.t
@@ -0,0 +1,117 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+
+{
+    package Foo;
+    use Moose;
+
+    sub foo { 'Foo::foo(' . (inner() || '') . ')' }
+    sub bar { 'Foo::bar(' . (inner() || '') . ')' }
+    sub baz { 'Foo::baz(' . (inner() || '') . ')' }
+
+    package Bar;
+    use Moose;
+
+    extends 'Foo';
+
+    augment foo => sub { 'Bar::foo(' . (inner() || '') . ')' };
+    augment bar => sub { 'Bar::bar' };
+
+    no Moose; # ensure inner() still works after unimport
+
+    package Baz;
+    use Moose;
+
+    extends 'Bar';
+
+    augment foo => sub { 'Baz::foo' };
+    augment baz => sub { 'Baz::baz' };
+
+    # this will actually never run,
+    # because Bar::bar does not call inner()
+    augment bar => sub { 'Baz::bar' };
+}
+
+my $baz = Baz->new();
+isa_ok($baz, 'Baz');
+isa_ok($baz, 'Bar');
+isa_ok($baz, 'Foo');
+
+is($baz->foo(), 'Foo::foo(Bar::foo(Baz::foo))', '... got the right value from &foo');
+is($baz->bar(), 'Foo::bar(Bar::bar)', '... got the right value from &bar');
+is($baz->baz(), 'Foo::baz(Baz::baz)', '... got the right value from &baz');
+
+my $bar = Bar->new();
+isa_ok($bar, 'Bar');
+isa_ok($bar, 'Foo');
+
+is($bar->foo(), 'Foo::foo(Bar::foo())', '... got the right value from &foo');
+is($bar->bar(), 'Foo::bar(Bar::bar)', '... got the right value from &bar');
+is($bar->baz(), 'Foo::baz()', '... got the right value from &baz');
+
+my $foo = Foo->new();
+isa_ok($foo, 'Foo');
+
+is($foo->foo(), 'Foo::foo()', '... got the right value from &foo');
+is($foo->bar(), 'Foo::bar()', '... got the right value from &bar');
+is($foo->baz(), 'Foo::baz()', '... got the right value from &baz');
+
+# test saved state when crossing objects
+
+{
+    package X;
+    use Moose;
+    has name => (is => 'rw');
+    sub run {
+        "$_[0]->{name}.X", inner()
+    }
+
+    package Y;
+    use Moose;
+    extends 'X';
+    augment 'run' => sub {
+        "$_[0]->{name}.Y", ($_[1] ? $_[1]->() : ()), inner();
+    };
+
+    package Z;
+    use Moose;
+    extends 'Y';
+    augment 'run' => sub {
+        "$_[0]->{name}.Z"
+    }
+}
+
+is('a.X a.Y b.X b.Y b.Z a.Z',
+   do {
+       my $a = Z->new(name => 'a');
+       my $b = Z->new(name => 'b');
+       join(' ', $a->run(sub { $b->run }))
+   },
+   'State is saved when cross-calling augmented methods on different objects');
+
+# some error cases
+
+{
+    package Bling;
+    use Moose;
+
+    sub bling { 'Bling::bling' }
+
+    package Bling::Bling;
+    use Moose;
+
+    extends 'Bling';
+
+    sub bling { 'Bling::bling' }
+
+    ::isnt( ::exception {
+        augment 'bling' => sub {};
+    }, undef, '... cannot augment a method which has a local equivalent' );
+
+}
+
+done_testing;
diff --git a/t/basics/load_into_main.t b/t/basics/load_into_main.t
new file mode 100644
index 0000000..ddfb834
--- /dev/null
+++ b/t/basics/load_into_main.t
@@ -0,0 +1,16 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+is( exception {
+    eval 'use Moose';
+}, undef, "export to main" );
+
+isa_ok( main->meta, "Moose::Meta::Class" );
+
+isa_ok( main->new, "main");
+isa_ok( main->new, "Moose::Object" );
+
+done_testing;
diff --git a/t/basics/method_modifier_with_regexp.t b/t/basics/method_modifier_with_regexp.t
new file mode 100644
index 0000000..8f9319b
--- /dev/null
+++ b/t/basics/method_modifier_with_regexp.t
@@ -0,0 +1,84 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+
+{
+
+    package Dog;
+    use Moose;
+
+    sub bark_once {
+        my $self = shift;
+        return 'bark';
+    }
+
+    sub bark_twice {
+        return 'barkbark';
+    }
+
+    around qr/bark.*/ => sub {
+        'Dog::around(' . $_[0]->() . ')';
+    };
+
+}
+
+my $dog = Dog->new;
+is( $dog->bark_once,  'Dog::around(bark)', 'around modifier is called' );
+is( $dog->bark_twice, 'Dog::around(barkbark)', 'around modifier is called' );
+
+{
+
+    package Cat;
+    use Moose;
+    our $BEFORE_BARK_COUNTER = 0;
+    our $AFTER_BARK_COUNTER  = 0;
+
+    sub bark_once {
+        my $self = shift;
+        return 'bark';
+    }
+
+    sub bark_twice {
+        return 'barkbark';
+    }
+
+    before qr/bark.*/ => sub {
+        $BEFORE_BARK_COUNTER++;
+    };
+
+    after qr/bark.*/ => sub {
+        $AFTER_BARK_COUNTER++;
+    };
+
+}
+
+my $cat = Cat->new;
+$cat->bark_once;
+is( $Cat::BEFORE_BARK_COUNTER, 1, 'before modifier is called once' );
+is( $Cat::AFTER_BARK_COUNTER,  1, 'after modifier is called once' );
+$cat->bark_twice;
+is( $Cat::BEFORE_BARK_COUNTER, 2, 'before modifier is called twice' );
+is( $Cat::AFTER_BARK_COUNTER,  2, 'after modifier is called twice' );
+
+{
+    package Dog::Role;
+    use Moose::Role;
+
+    ::isnt( ::exception {
+        before qr/bark.*/ => sub {};
+    }, undef, '... this is not currently supported' );
+
+    ::isnt( ::exception {
+        around qr/bark.*/ => sub {};
+    }, undef, '... this is not currently supported' );
+
+    ::isnt( ::exception {
+        after  qr/bark.*/ => sub {};
+    }, undef, '... this is not currently supported' );
+
+}
+
+done_testing;
diff --git a/t/basics/methods.t b/t/basics/methods.t
new file mode 100644
index 0000000..da34a07
--- /dev/null
+++ b/t/basics/methods.t
@@ -0,0 +1,44 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+
+my $test1 = Moose::Meta::Class->create_anon_class;
+$test1->add_method( 'foo1', sub { } );
+
+my $t1    = $test1->new_object;
+my $t1_am = $t1->meta->get_method('foo1')->associated_metaclass;
+
+ok( $t1_am, 'associated_metaclass is defined' );
+
+isa_ok(
+    $t1_am, 'Moose::Meta::Class',
+    'associated_metaclass is correct class'
+);
+
+like( $t1_am->name(), qr/::__ANON__::/,
+    'associated_metaclass->name looks like an anonymous class' );
+
+{
+    package Test2;
+
+    use Moose;
+
+    sub foo2 { }
+}
+
+my $t2    = Test2->new;
+my $t2_am = $t2->meta->get_method('foo2')->associated_metaclass;
+
+ok( $t2_am, 'associated_metaclass is defined' );
+
+isa_ok(
+    $t2_am, 'Moose::Meta::Class',
+    'associated_metaclass is correct class'
+);
+
+is( $t2_am->name(), 'Test2',
+    'associated_metaclass->name is Test2' );
+
+done_testing;
diff --git a/t/basics/moose_object_does.t b/t/basics/moose_object_does.t
new file mode 100644
index 0000000..87338af
--- /dev/null
+++ b/t/basics/moose_object_does.t
@@ -0,0 +1,158 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Moose;
+
+{
+    package Role::A;
+    use Moose::Role
+}
+
+{
+    package Role::B;
+    use Moose::Role
+}
+
+{
+    package Foo;
+    use Moose;
+}
+
+{
+    package Bar;
+    use Moose;
+
+    with 'Role::A';
+}
+
+{
+    package Baz;
+    use Moose;
+
+    with qw( Role::A Role::B );
+}
+
+{
+    package Foo::Child;
+    use Moose;
+
+    extends 'Foo';
+}
+
+{
+    package Bar::Child;
+    use Moose;
+
+    extends 'Bar';
+}
+
+{
+    package Baz::Child;
+    use Moose;
+
+    extends 'Baz';
+}
+
+with_immutable {
+
+    for my $thing ( 'Foo', Foo->new, 'Foo::Child', Foo::Child->new ) {
+        my $name = ref $thing ? (ref $thing) . ' object' : "$thing class";
+        $name .= ' (immutable)' if $thing->meta->is_immutable;
+
+        ok(
+            !$thing->does('Role::A'),
+            "$name does not do Role::A"
+        );
+        ok(
+            !$thing->does('Role::B'),
+            "$name does not do Role::B"
+        );
+
+        ok(
+            !$thing->does( Role::A->meta ),
+            "$name does not do Role::A (passed as object)"
+        );
+        ok(
+            !$thing->does( Role::B->meta ),
+            "$name does not do Role::B (passed as object)"
+        );
+
+        ok(
+            !$thing->DOES('Role::A'),
+            "$name does not do Role::A (using DOES)"
+        );
+        ok(
+            !$thing->DOES('Role::B'),
+            "$name does not do Role::B (using DOES)"
+        );
+    }
+
+    for my $thing ( 'Bar', Bar->new, 'Bar::Child', Bar::Child->new ) {
+        my $name = ref $thing ? (ref $thing) . ' object' : "$thing class";
+        $name .= ' (immutable)' if $thing->meta->is_immutable;
+
+        ok(
+            $thing->does('Role::A'),
+            "$name does Role::A"
+        );
+        ok(
+            !$thing->does('Role::B'),
+            "$name does not do Role::B"
+        );
+
+        ok(
+            $thing->does( Role::A->meta ),
+            "$name does Role::A (passed as object)"
+        );
+        ok(
+            !$thing->does( Role::B->meta ),
+            "$name does not do Role::B (passed as object)"
+        );
+
+        ok(
+            $thing->DOES('Role::A'),
+            "$name does Role::A (using DOES)"
+        );
+        ok(
+            !$thing->DOES('Role::B'),
+            "$name does not do Role::B (using DOES)"
+        );
+    }
+
+    for my $thing ( 'Baz', Baz->new, 'Baz::Child', Baz::Child->new ) {
+        my $name = ref $thing ? (ref $thing) . ' object' : "$thing class";
+        $name .= ' (immutable)' if $thing->meta->is_immutable;
+
+        ok(
+            $thing->does('Role::A'),
+            "$name does Role::A"
+        );
+        ok(
+            $thing->does('Role::B'),
+            "$name does Role::B"
+        );
+
+        ok(
+            $thing->does( Role::A->meta ),
+            "$name does Role::A (passed as object)"
+        );
+        ok(
+            $thing->does( Role::B->meta ),
+            "$name does Role::B (passed as object)"
+        );
+
+        ok(
+            $thing->DOES('Role::A'),
+            "$name does Role::A (using DOES)"
+        );
+        ok(
+            $thing->DOES('Role::B'),
+            "$name does Role::B (using DOES)"
+        );
+    }
+
+}
+qw( Foo Bar Baz Foo::Child Bar::Child Baz::Child );
+
+done_testing;
diff --git a/t/basics/moose_respects_type_constraints.t b/t/basics/moose_respects_type_constraints.t
new file mode 100644
index 0000000..5dba161
--- /dev/null
+++ b/t/basics/moose_respects_type_constraints.t
@@ -0,0 +1,59 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+use Moose::Util::TypeConstraints;
+
+=pod
+
+This tests demonstrates that Moose will not override
+a preexisting type constraint of the same name when
+making constraints for a Moose-class.
+
+It also tests that an attribute which uses a 'Foo' for
+its isa option will get the subtype Foo, and not a
+type representing the Foo moose class.
+
+=cut
+
+BEGIN {
+    # create this subtype first (in BEGIN)
+    subtype Foo
+        => as 'Value'
+        => where { $_ eq 'Foo' };
+}
+
+{ # now seee if Moose will override it
+    package Foo;
+    use Moose;
+}
+
+my $foo_constraint = find_type_constraint('Foo');
+isa_ok($foo_constraint, 'Moose::Meta::TypeConstraint');
+
+is($foo_constraint->parent->name, 'Value', '... got the Value subtype for Foo');
+
+ok($foo_constraint->check('Foo'), '... my constraint passed correctly');
+ok(!$foo_constraint->check('Bar'), '... my constraint failed correctly');
+
+{
+    package Bar;
+    use Moose;
+
+    has 'foo' => (is => 'rw', isa => 'Foo');
+}
+
+my $bar = Bar->new;
+isa_ok($bar, 'Bar');
+
+is( exception {
+    $bar->foo('Foo');
+}, undef, '... checked the type constraint correctly' );
+
+isnt( exception {
+    $bar->foo(Foo->new);
+}, undef, '... checked the type constraint correctly' );
+
+done_testing;
diff --git a/t/basics/override_and_foreign_classes.t b/t/basics/override_and_foreign_classes.t
new file mode 100644
index 0000000..f671fe9
--- /dev/null
+++ b/t/basics/override_and_foreign_classes.t
@@ -0,0 +1,72 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+
+=pod
+
+This just tests the interaction of override/super
+with non-Moose superclasses. It really should not
+cause issues, the only thing it does is to create
+a metaclass for Foo so that it can find the right
+super method.
+
+This may end up being a sensitive issue for some
+non-Moose classes, but in 99% of the cases it
+should be just fine.
+
+=cut
+
+{
+    package Foo;
+    use strict;
+    use warnings;
+
+    sub new { bless {} => shift() }
+
+    sub foo { 'Foo::foo' }
+    sub bar { 'Foo::bar' }
+    sub baz { 'Foo::baz' }
+
+    package Bar;
+    use Moose;
+
+    extends 'Foo';
+
+    override bar => sub { 'Bar::bar -> ' . super() };
+
+    package Baz;
+    use Moose;
+
+    extends 'Bar';
+
+    override bar => sub { 'Baz::bar -> ' . super() };
+    override baz => sub { 'Baz::baz -> ' . super() };
+}
+
+my $baz = Baz->new();
+isa_ok($baz, 'Baz');
+isa_ok($baz, 'Bar');
+isa_ok($baz, 'Foo');
+
+is($baz->foo(), 'Foo::foo', '... got the right value from &foo');
+is($baz->bar(), 'Baz::bar -> Bar::bar -> Foo::bar', '... got the right value from &bar');
+is($baz->baz(), 'Baz::baz -> Foo::baz', '... got the right value from &baz');
+
+my $bar = Bar->new();
+isa_ok($bar, 'Bar');
+isa_ok($bar, 'Foo');
+
+is($bar->foo(), 'Foo::foo', '... got the right value from &foo');
+is($bar->bar(), 'Bar::bar -> Foo::bar', '... got the right value from &bar');
+is($bar->baz(), 'Foo::baz', '... got the right value from &baz');
+
+my $foo = Foo->new();
+isa_ok($foo, 'Foo');
+
+is($foo->foo(), 'Foo::foo', '... got the right value from &foo');
+is($foo->bar(), 'Foo::bar', '... got the right value from &bar');
+is($foo->baz(), 'Foo::baz', '... got the right value from &baz');
+
+done_testing;
diff --git a/t/basics/override_augment_inner_super.t b/t/basics/override_augment_inner_super.t
new file mode 100644
index 0000000..7ec35ea
--- /dev/null
+++ b/t/basics/override_augment_inner_super.t
@@ -0,0 +1,69 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+
+{
+    package Foo;
+    use Moose;
+
+    sub foo { 'Foo::foo(' . (inner() || '') . ')' };
+    sub bar { 'Foo::bar(' . (inner() || '') . ')' }
+
+    package Bar;
+    use Moose;
+
+    extends 'Foo';
+
+    augment  'foo' => sub { 'Bar::foo' };
+    override 'bar' => sub { 'Bar::bar -> ' . super() };
+
+    package Baz;
+    use Moose;
+
+    extends 'Bar';
+
+    override 'foo' => sub { 'Baz::foo -> ' . super() };
+    augment  'bar' => sub { 'Baz::bar' };
+}
+
+my $baz = Baz->new();
+isa_ok($baz, 'Baz');
+isa_ok($baz, 'Bar');
+isa_ok($baz, 'Foo');
+
+=pod
+
+Let em clarify what is happening here. Baz::foo is calling
+super(), which calls Bar::foo, which is an augmented sub
+that calls Foo::foo, then calls inner() which actually
+then calls Bar::foo. Confusing I know,.. but this is
+*exactly* what is it supposed to do :)
+
+=cut
+
+is($baz->foo,
+  'Baz::foo -> Foo::foo(Bar::foo)',
+  '... got the right value from mixed augment/override foo');
+
+=pod
+
+Allow me to clarify this one now ...
+
+Since Baz::bar is an augment routine, it needs to find the
+correct inner() to be called by. In this case it is Foo::bar.
+However, Bar::bar is in-between us, so it should actually be
+called first. Bar::bar is an overriden sub, and calls super()
+which in turn then calls our Foo::bar, which calls inner(),
+which calls Baz::bar.
+
+Confusing I know, but it is correct :)
+
+=cut
+
+is($baz->bar,
+    'Bar::bar -> Foo::bar(Baz::bar)',
+    '... got the right value from mixed augment/override bar');
+
+done_testing;
diff --git a/t/basics/rebless.t b/t/basics/rebless.t
new file mode 100644
index 0000000..db08d6b
--- /dev/null
+++ b/t/basics/rebless.t
@@ -0,0 +1,136 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+use Test::Moose qw(with_immutable);
+use Scalar::Util 'blessed';
+
+use Moose::Util::TypeConstraints;
+
+subtype 'Positive'
+     => as 'Num'
+     => where { $_ > 0 };
+
+{
+    package Parent;
+    use Moose;
+
+    has name => (
+        is       => 'rw',
+        isa      => 'Str',
+    );
+
+    has lazy_classname => (
+        is      => 'ro',
+        lazy    => 1,
+        default => sub { "Parent" },
+    );
+
+    has type_constrained => (
+        is      => 'rw',
+        isa     => 'Num',
+        default => 5.5,
+    );
+
+    package Child;
+    use Moose;
+    extends 'Parent';
+
+    has '+name' => (
+        default => 'Junior',
+    );
+
+    has '+lazy_classname' => (
+        default => sub {"Child"},
+    );
+
+    has '+type_constrained' => (
+        isa     => 'Int',
+        default => 100,
+    );
+
+    our %trigger_calls;
+    our %initializer_calls;
+
+    has new_attr => (
+        is      => 'rw',
+        isa     => 'Str',
+        trigger => sub {
+            my ( $self, $val, $attr ) = @_;
+            $trigger_calls{new_attr}++;
+        },
+        initializer => sub {
+            my ( $self, $value, $set, $attr ) = @_;
+            $initializer_calls{new_attr}++;
+            $set->($value);
+        },
+    );
+}
+
+my @classes = qw(Parent Child);
+
+with_immutable {
+    my $foo = Parent->new;
+    my $bar = Parent->new;
+
+    is( blessed($foo),        'Parent', 'Parent->new gives a Parent object' );
+    is( $foo->name,           undef,    'No name yet' );
+    is( $foo->lazy_classname, 'Parent', "lazy attribute initialized" );
+    is(
+        exception { $foo->type_constrained(10.5) }, undef,
+        "Num type constraint for now.."
+    );
+
+    # try to rebless, except it will fail due to Child's stricter type constraint
+    like(
+        exception { Child->meta->rebless_instance($foo) },
+        qr/^Attribute \(type_constrained\) does not pass the type constraint because\: Validation failed for 'Int' with value 10\.5/,
+        '... this failed because of type check'
+    );
+    like(
+        exception { Child->meta->rebless_instance($bar) },
+        qr/^Attribute \(type_constrained\) does not pass the type constraint because\: Validation failed for 'Int' with value 5\.5/,
+        '... this failed because of type check'
+    );
+
+    $foo->type_constrained(10);
+    $bar->type_constrained(5);
+
+    Child->meta->rebless_instance($foo);
+    Child->meta->rebless_instance( $bar, new_attr => 'blah' );
+
+    is( blessed($foo), 'Child',  'successfully reblessed into Child' );
+    is( $foo->name,    'Junior', "Child->name's default came through" );
+
+    is(
+        $foo->lazy_classname, 'Parent',
+        "lazy attribute was already initialized"
+    );
+    is(
+        $bar->lazy_classname, 'Child',
+        "lazy attribute just now initialized"
+    );
+
+    like(
+        exception { $foo->type_constrained(10.5) },
+        qr/^Attribute \(type_constrained\) does not pass the type constraint because\: Validation failed for 'Int' with value 10\.5/,
+        '... this failed because of type check'
+    );
+
+    is_deeply(
+        \%Child::trigger_calls, { new_attr => 1 },
+        'Trigger fired on rebless_instance'
+    );
+    is_deeply(
+        \%Child::initializer_calls, { new_attr => 1 },
+        'Initializer fired on rebless_instance'
+    );
+
+    undef %Child::trigger_calls;
+    undef %Child::initializer_calls;
+
+}
+@classes;
+
+done_testing;
diff --git a/t/basics/require_superclasses.t b/t/basics/require_superclasses.t
new file mode 100644
index 0000000..f2b1683
--- /dev/null
+++ b/t/basics/require_superclasses.t
@@ -0,0 +1,64 @@
+use strict;
+use warnings;
+
+use lib 't/lib';
+
+use Test::More;
+use Test::Fatal;
+
+
+{
+
+    package Bar;
+    use Moose;
+
+    ::is( ::exception { extends 'Foo' }, undef, 'loaded Foo superclass correctly' );
+}
+
+{
+
+    package Baz;
+    use Moose;
+
+    ::is( ::exception { extends 'Bar' }, undef, 'loaded (inline) Bar superclass correctly' );
+}
+
+{
+
+    package Foo::Bar;
+    use Moose;
+
+    ::is( ::exception { extends 'Foo', 'Bar' }, undef, 'loaded Foo and (inline) Bar superclass correctly' );
+}
+
+{
+
+    package Bling;
+    use Moose;
+
+    my $warnings = '';
+    local $SIG{__WARN__} = sub { $warnings .= $_[0] };
+    ::is( ::exception { extends 'No::Class' }, undef, "extending an empty package is a valid thing to do" );
+    ::like( $warnings, qr/^Can't locate package No::Class for \@Bling::ISA/, "but it does give a warning" );
+}
+
+{
+    package Affe;
+    our $VERSION = 23;
+}
+
+{
+    package Tiger;
+    use Moose;
+
+    ::is( ::exception { extends 'Foo', Affe => { -version => 13 } }, undef, 'extends with version requirement' );
+}
+
+{
+    package Birne;
+    use Moose;
+
+    ::like( ::exception { extends 'Foo', Affe => { -version => 42 } }, qr/Affe version 42 required--this is only version 23/, 'extends with unsatisfied version requirement' );
+}
+
+done_testing;
diff --git a/t/basics/super_and_override.t b/t/basics/super_and_override.t
new file mode 100644
index 0000000..edebc71
--- /dev/null
+++ b/t/basics/super_and_override.t
@@ -0,0 +1,79 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+
+{
+    package Foo;
+    use Moose;
+
+    sub foo { 'Foo::foo' }
+    sub bar { 'Foo::bar' }
+    sub baz { 'Foo::baz' }
+
+    package Bar;
+    use Moose;
+
+    extends 'Foo';
+
+    override bar => sub { 'Bar::bar -> ' . super() };
+
+    package Baz;
+    use Moose;
+
+    extends 'Bar';
+
+    override bar => sub { 'Baz::bar -> ' . super() };
+    override baz => sub { 'Baz::baz -> ' . super() };
+
+    no Moose; # ensure super() still works after unimport
+}
+
+my $baz = Baz->new();
+isa_ok($baz, 'Baz');
+isa_ok($baz, 'Bar');
+isa_ok($baz, 'Foo');
+
+is($baz->foo(), 'Foo::foo', '... got the right value from &foo');
+is($baz->bar(), 'Baz::bar -> Bar::bar -> Foo::bar', '... got the right value from &bar');
+is($baz->baz(), 'Baz::baz -> Foo::baz', '... got the right value from &baz');
+
+my $bar = Bar->new();
+isa_ok($bar, 'Bar');
+isa_ok($bar, 'Foo');
+
+is($bar->foo(), 'Foo::foo', '... got the right value from &foo');
+is($bar->bar(), 'Bar::bar -> Foo::bar', '... got the right value from &bar');
+is($bar->baz(), 'Foo::baz', '... got the right value from &baz');
+
+my $foo = Foo->new();
+isa_ok($foo, 'Foo');
+
+is($foo->foo(), 'Foo::foo', '... got the right value from &foo');
+is($foo->bar(), 'Foo::bar', '... got the right value from &bar');
+is($foo->baz(), 'Foo::baz', '... got the right value from &baz');
+
+# some error cases
+
+{
+    package Bling;
+    use Moose;
+
+    sub bling { 'Bling::bling' }
+
+    package Bling::Bling;
+    use Moose;
+
+    extends 'Bling';
+
+    sub bling { 'Bling::bling' }
+
+    ::isnt( ::exception {
+        override 'bling' => sub {};
+    }, undef, '... cannot override a method which has a local equivalent' );
+
+}
+
+done_testing;
diff --git a/t/basics/super_warns_on_args.t b/t/basics/super_warns_on_args.t
new file mode 100644
index 0000000..3600d9f
--- /dev/null
+++ b/t/basics/super_warns_on_args.t
@@ -0,0 +1,44 @@
+use strict;
+use warnings;
+
+use Test::Requires 'Test::Output';
+use Test::More;
+
+{
+    package Parent;
+    use Moose;
+
+    sub foo { 42 }
+    sub bar { 42 }
+
+    package Child;
+    use Moose;
+
+    extends 'Parent';
+
+    override foo => sub {
+        super( 1, 2, 3 );
+    };
+
+    override bar => sub {
+        super();
+    };
+}
+
+{
+    my $file = __FILE__;
+
+    stderr_like(
+        sub { Child->new->foo },
+        qr/\QArguments passed to super() are ignored at $file/,
+        'got a warning when passing args to super() call'
+    );
+
+    stderr_is(
+        sub { Child->new->bar },
+        q{},
+        'no warning on super() call without arguments'
+    );
+}
+
+done_testing();
diff --git a/t/basics/universal_methods_wrappable.t b/t/basics/universal_methods_wrappable.t
new file mode 100644
index 0000000..350688c
--- /dev/null
+++ b/t/basics/universal_methods_wrappable.t
@@ -0,0 +1,29 @@
+use strict;
+use warnings;
+
+use Test::Fatal;
+use Test::More;
+
+{
+
+    package FakeBar;
+    use Moose::Role;
+
+    around isa => sub {
+        my ( $orig, $self, $v ) = @_;
+        return 1 if $v eq 'Bar';
+        return $orig->( $self, $v );
+    };
+
+    package Foo;
+    use Moose;
+
+    use Test::More;
+
+    ::is( ::exception { with 'FakeBar' }, undef, 'applied role' );
+
+    my $foo = Foo->new;
+    ::isa_ok( $foo, 'Bar' );
+}
+
+done_testing;
diff --git a/t/basics/wrapped_method_cxt_propagation.t b/t/basics/wrapped_method_cxt_propagation.t
new file mode 100644
index 0000000..ce1e243
--- /dev/null
+++ b/t/basics/wrapped_method_cxt_propagation.t
@@ -0,0 +1,56 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+
+{
+    package TouchyBase;
+    use Moose;
+
+    has x => ( is => 'rw', default => 0 );
+
+    sub inc { $_[0]->x( 1 + $_[0]->x ) }
+
+    sub scalar_or_array {
+        wantarray ? (qw/a b c/) : "x";
+    }
+
+    sub void {
+        die "this must be void context" if defined wantarray;
+    }
+
+    package AfterSub;
+    use Moose;
+
+    extends "TouchyBase";
+
+    after qw/scalar_or_array void/ => sub {
+        my $self = shift;
+        $self->inc;
+    }
+}
+
+my $base = TouchyBase->new;
+my $after = AfterSub->new;
+
+foreach my $obj ( $base, $after ) {
+    my $class = ref $obj;
+    my @array = $obj->scalar_or_array;
+    my $scalar = $obj->scalar_or_array;
+
+    is_deeply(\@array, [qw/a b c/], "array context ($class)");
+    is($scalar, "x", "scalar context ($class)");
+
+    {
+        local $@;
+        eval { $obj->void };
+        ok( !$@, "void context ($class)" );
+    }
+
+    if ( $obj->isa("AfterSub") ) {
+        is( $obj->x, 3, "methods were wrapped" );
+    }
+}
+
+done_testing;