Add t/lib/Mo and a bunch of tests

t/lib/Mo/Bar.pm

@@ -0,0 +1,4 @@
+package Bar;
+use Mo;
+extends 'Foo';
+1;

t/lib/Mo/Boo.pm

@@ -0,0 +1,6 @@
+package Boo;
+use Mo;
+
+has 'buff';
+
+1;

t/lib/Mo/Foo.pm

@@ -0,0 +1,6 @@
+package Foo;
+use Mo;
+
+has 'stuff';
+
+1;

t/lib/Mo/build.t

@@ -0,0 +1,51 @@
+#!/usr/bin/perl
+
+BEGIN {
+   die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n"
+      unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH};
+   unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib";
+};
+
+use strict;
+use warnings FATAL => 'all';
+use English qw(-no_match_vars);
+use Test::More;
+
+$main::count = 1;
+
+package Foo;
+use Mo 'build';
+has 'foo' => (is => 'rw');
+sub BUILD {
+    my $self = shift;
+    ::is_deeply(\@_, [qw(stuff 1)], "Foo's BUILD doesn't get the class name");
+    $self->foo($main::count++);
+}
+
+package Bar;
+use Mo;
+extends 'Foo';
+has 'bar' => (is => 'rw');
+
+package Baz;
+use Mo;
+extends 'Bar';
+has 'baz' => (is => 'rw');
+sub BUILD {
+    my $self = shift;
+    ::is_deeply(\@_, [qw(stuff 1)], "Baz's BUILD doesn't get the class name");
+    $self->baz($main::count++);
+}
+
+package Gorch;
+use Mo;
+extends 'Baz';
+has 'gorch' => (is => 'rw');
+
+package main;
+
+my $g = Gorch->new(stuff => 1);
+is $g->foo, 1, 'foo builds first';
+is $g->baz, 2, 'baz builds second';
+
+done_testing;

t/lib/Mo/buildargs.t

@@ -0,0 +1,62 @@
+#!/usr/bin/perl
+
+BEGIN {
+   die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n"
+      unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH};
+   unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib";
+};
+
+use strict;
+use warnings FATAL => 'all';
+use English qw(-no_match_vars);
+use Test::More;
+
+$main::count = 0;
+
+{
+   package Nothing;
+   use Mo;
+   has nothing_special => ( is => 'rw' );
+}
+ok(Nothing->can("BUILDARGS"), "Every class automatically gets buildargs");
+
+package Foo;
+use Mo;
+has 'foo' => (is => 'rw');
+sub BUILDARGS {
+    my $class = shift;
+    $main::count++;
+    $class->SUPER::BUILDARGS(@_);
+}
+
+package Bar;
+use Mo;
+extends 'Foo';
+has 'bar' => (is => 'rw');
+
+package Baz;
+use Mo;
+extends 'Bar';
+has 'baz' => (is => 'rw');
+sub BUILDARGS {
+    my $class = shift;
+    $main::count++;
+    $class->SUPER::BUILDARGS(@_)
+}
+
+package Gorch;
+use Mo;
+extends 'Baz';
+has 'gorch' => (is => 'rw');
+
+package main;
+
+$main::count = 0;
+my $g = Foo->new;
+is $main::count, 1, "A class with no explicit parent inherits SUPER::BUILDARGS from Mo::Object";
+
+$main::count = 0;
+$g = Gorch->new;
+is $main::count, 2, "As does one with a parent that defines it's own BUILDARGS";
+
+done_testing;

t/lib/Mo/coerce.t

@@ -0,0 +1,26 @@
+#!/usr/bin/perl
+
+BEGIN {
+   die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n"
+      unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH};
+   unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib";
+};
+
+use strict;
+use warnings FATAL => 'all';
+use English qw(-no_match_vars);
+use Test::More;
+
+plan tests => 2;
+
+package Foo::coerce;
+use Mo;
+
+has 'stuff' => (coerce => sub { uc $_[0] });
+
+package main;
+
+my $f = Foo::coerce->new(stuff => 'fubar');
+is $f->stuff, 'FUBAR', 'values passed to constructor are successfully coerced';
+$f->stuff('barbaz');
+is $f->stuff, 'BARBAZ', 'values passed to setters are successfully coerced';

t/lib/Mo/extends.t

@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+
+BEGIN {
+   die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n"
+      unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH};
+   unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib";
+};
+
+use strict;
+use warnings FATAL => 'all';
+use English qw(-no_match_vars);
+use Test::More tests => 4;
+
+use lib "$ENV{PERCONA_TOOLKIT_BRANCH}/t/lib/Mo";
+use Bar;
+
+my $b = Bar->new;
+
+ok $b->isa('Foo'), 'Bar is a subclass of Foo';
+
+is "@Bar::ISA", "Foo", 'Extends with multiple classes not supported';
+
+ok 'Foo'->can('stuff'), 'Foo is loaded';
+ok not('Bar'->can('buff')), 'Boo is not loaded';

t/lib/Mo/handles.t

@@ -0,0 +1,480 @@
+#!/usr/bin/perl
+
+BEGIN {
+   die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n"
+      unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH};
+   unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib";
+};
+
+use strict;
+use warnings FATAL => 'all';
+use English qw(-no_match_vars);
+use Test::More tests => 82;
+
+
+# -------------------------------------------------------------------
+# HASH handles
+# -------------------------------------------------------------------
+# the canonical form of of the 'handles'
+# option is the hash ref mapping a
+# method name to the delegated method name
+
+{
+    package Foo;
+    use Mo qw(is required handles default builder);
+
+    has 'bar' => (is => 'rw', default => sub { 10 });
+
+    sub baz { 42 }
+
+    package Bar;
+    use Mo qw(is required handles default builder);
+
+    has 'foo' => (
+        is      => 'rw',
+        default => sub { Foo->new },
+        handles => {
+            'foo_bar' => 'bar',
+            foo_baz   => 'baz',
+            'foo_bar_to_20' => [ bar => 20 ],
+        },
+    );
+}
+
+my $bar = Bar->new;
+isa_ok($bar, 'Bar');
+
+ok($bar->foo, '... we have something in bar->foo');
+isa_ok($bar->foo, 'Foo');
+
+is($bar->foo->bar, 10, '... bar->foo->bar returned the right default');
+
+can_ok($bar, 'foo_bar');
+is($bar->foo_bar, 10, '... bar->foo_bar delegated correctly');
+
+# change the value ...
+
+$bar->foo->bar(30);
+
+# and make sure the delegation picks it up
+
+is($bar->foo->bar, 30, '... bar->foo->bar returned the right (changed) value');
+is($bar->foo_bar, 30, '... bar->foo_bar delegated correctly');
+
+# change the value through the delegation ...
+
+$bar->foo_bar(50);
+
+# and make sure everyone sees it
+
+is($bar->foo->bar, 50, '... bar->foo->bar returned the right (changed) value');
+is($bar->foo_bar, 50, '... bar->foo_bar delegated correctly');
+
+# change the object we are delegating too
+
+my $foo = Foo->new(bar => 25);
+isa_ok($foo, 'Foo');
+
+is($foo->bar, 25, '... got the right foo->bar');
+
+local $@;
+eval { $bar->foo($foo) };
+is $@, '', '... assigned the new Foo to Bar->foo';
+
+is($bar->foo, $foo, '... assigned bar->foo with the new Foo');
+
+is($bar->foo->bar, 25, '... bar->foo->bar returned the right result');
+is($bar->foo_bar, 25, '... and bar->foo_bar delegated correctly again');
+
+# curried handles
+$bar->foo_bar_to_20;
+is($bar->foo_bar, 20, '... correctly curried a single argument');
+
+# -------------------------------------------------------------------
+# ARRAY handles
+# -------------------------------------------------------------------
+# we also support an array based format
+# which assumes that the name is the same
+# on either end
+
+{
+    package Engine;
+    use Mo qw(is required handles default builder);
+
+    sub go   { 'Engine::go'   }
+    sub stop { 'Engine::stop' }
+
+    package Car;
+    use Mo qw(is required handles default builder);
+
+    has 'engine' => (
+        is      => 'rw',
+        default => sub { Engine->new },
+        handles => [ 'go', 'stop' ]
+    );
+}
+
+my $car = Car->new;
+isa_ok($car, 'Car');
+
+isa_ok($car->engine, 'Engine');
+can_ok($car->engine, 'go');
+can_ok($car->engine, 'stop');
+
+is($car->engine->go, 'Engine::go', '... got the right value from ->engine->go');
+is($car->engine->stop, 'Engine::stop', '... got the right value from ->engine->stop');
+
+can_ok($car, 'go');
+can_ok($car, 'stop');
+
+is($car->go, 'Engine::go', '... got the right value from ->go');
+is($car->stop, 'Engine::stop', '... got the right value from ->stop');
+
+# -------------------------------------------------------------------
+# REGEXP handles
+# -------------------------------------------------------------------
+# and we support regexp delegation
+
+{
+    package Baz;
+    use Mo qw(is required handles default builder);
+
+    sub foo { 'Baz::foo' }
+    sub bar { 'Baz::bar' }
+    sub boo { 'Baz::boo' }
+
+    package Baz::Proxy1;
+    use Mo qw(is required handles default builder);
+
+    has 'baz' => (
+        is      => 'ro',
+        isa     => 'Baz',
+        default => sub { Baz->new },
+        handles => qr/.*/
+    );
+
+    package Baz::Proxy2;
+    use Mo qw(is required handles default builder);
+
+    has 'baz' => (
+        is      => 'ro',
+        isa     => 'Baz',
+        default => sub { Baz->new },
+        handles => qr/.oo/
+    );
+
+    package Baz::Proxy3;
+    use Mo qw(is required handles default builder);
+
+    has 'baz' => (
+        is      => 'ro',
+        isa     => 'Baz',
+        default => sub { Baz->new },
+        handles => qr/b.*/
+    );
+}
+
+{
+    my $baz_proxy = Baz::Proxy1->new;
+    isa_ok($baz_proxy, 'Baz::Proxy1');
+
+    can_ok($baz_proxy, 'baz');
+    isa_ok($baz_proxy->baz, 'Baz');
+
+    can_ok($baz_proxy, 'foo');
+    can_ok($baz_proxy, 'bar');
+    can_ok($baz_proxy, 'boo');
+
+    is($baz_proxy->foo, 'Baz::foo', '... got the right proxied return value');
+    is($baz_proxy->bar, 'Baz::bar', '... got the right proxied return value');
+    is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');
+}
+{
+    my $baz_proxy = Baz::Proxy2->new;
+    isa_ok($baz_proxy, 'Baz::Proxy2');
+
+    can_ok($baz_proxy, 'baz');
+    isa_ok($baz_proxy->baz, 'Baz');
+
+    can_ok($baz_proxy, 'foo');
+    can_ok($baz_proxy, 'boo');
+
+    is($baz_proxy->foo, 'Baz::foo', '... got the right proxied return value');
+    is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');
+}
+{
+    my $baz_proxy = Baz::Proxy3->new;
+    isa_ok($baz_proxy, 'Baz::Proxy3');
+
+    can_ok($baz_proxy, 'baz');
+    isa_ok($baz_proxy->baz, 'Baz');
+
+    can_ok($baz_proxy, 'bar');
+    can_ok($baz_proxy, 'boo');
+
+    is($baz_proxy->bar, 'Baz::bar', '... got the right proxied return value');
+    is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');
+}
+
+# -------------------------------------------------------------------
+# ROLE handles
+# -------------------------------------------------------------------
+=begin
+{
+    package Foo::Bar;
+    use Moose::Role;
+
+    requires 'foo';
+    requires 'bar';
+
+    package Foo::Baz;
+    use Mo qw(is required handles default builder);
+
+    sub foo { 'Foo::Baz::FOO' }
+    sub bar { 'Foo::Baz::BAR' }
+    sub baz { 'Foo::Baz::BAZ' }
+
+    package Foo::Thing;
+    use Mo qw(is required handles default builder);
+
+    has 'thing' => (
+        is      => 'rw',
+        isa     => 'Foo::Baz',
+        handles => 'Foo::Bar',
+    );
+
+    package Foo::OtherThing;
+    use Mo qw(is required handles default builder);
+    use Moose::Util::TypeConstraints;
+
+    has 'other_thing' => (
+        is      => 'rw',
+        isa     => 'Foo::Baz',
+        handles => Mooose::Util::TypeConstraints::find_type_constraint('Foo::Bar'),
+    );
+}
+
+{
+    my $foo = Foo::Thing->new(thing => Foo::Baz->new);
+    isa_ok($foo, 'Foo::Thing');
+    isa_ok($foo->thing, 'Foo::Baz');
+
+    ok($foo->meta->has_method('foo'), '... we have the method we expect');
+    ok($foo->meta->has_method('bar'), '... we have the method we expect');
+    ok(!$foo->meta->has_method('baz'), '... we dont have the method we expect');
+
+    is($foo->foo, 'Foo::Baz::FOO', '... got the right value');
+    is($foo->bar, 'Foo::Baz::BAR', '... got the right value');
+    is($foo->thing->baz, 'Foo::Baz::BAZ', '... got the right value');
+}
+
+{
+    my $foo = Foo::OtherThing->new(other_thing => Foo::Baz->new);
+    isa_ok($foo, 'Foo::OtherThing');
+    isa_ok($foo->other_thing, 'Foo::Baz');
+
+    ok($foo->meta->has_method('foo'), '... we have the method we expect');
+    ok($foo->meta->has_method('bar'), '... we have the method we expect');
+    ok(!$foo->meta->has_method('baz'), '... we dont have the method we expect');
+
+    is($foo->foo, 'Foo::Baz::FOO', '... got the right value');
+    is($foo->bar, 'Foo::Baz::BAR', '... got the right value');
+    is($foo->other_thing->baz, 'Foo::Baz::BAZ', '... got the right value');
+}
+=cut
+# -------------------------------------------------------------------
+# AUTOLOAD & handles
+# -------------------------------------------------------------------
+
+{
+    package Foo::Autoloaded;
+    use Mo qw(is required handles default builder);
+    
+    sub AUTOLOAD {
+        my $self = shift;
+
+        my $name = our $AUTOLOAD;
+        $name =~ s/.*://; # strip fully-qualified portion
+
+        if (@_) {
+            return $self->{$name} = shift;
+        } else {
+            return $self->{$name};
+        }
+    }
+
+    package Bar::Autoloaded;
+    use Mo qw(is required handles default builder);
+
+    has 'foo' => (
+        is      => 'rw',
+        default => sub { Foo::Autoloaded->new },
+        handles => { 'foo_bar' => 'bar' }
+    );
+
+    package Baz::Autoloaded;
+    use Mo qw(is required handles default builder);
+
+    has 'foo' => (
+        is      => 'rw',
+        default => sub { Foo::Autoloaded->new },
+        handles => ['bar']
+    );
+
+    package Goorch::Autoloaded;
+    use Mo qw(is required handles default builder);
+
+    eval {
+        has 'foo' => (
+            is      => 'rw',
+            default => sub { Foo::Autoloaded->new },
+            handles => qr/bar/
+        );
+    };
+    ::isnt($@, '', '... you cannot delegate to AUTOLOADED class with regexp' );
+}
+
+# check HASH based delegation w/ AUTOLOAD
+
+{
+    my $bar = Bar::Autoloaded->new;
+    isa_ok($bar, 'Bar::Autoloaded');
+
+    ok($bar->foo, '... we have something in bar->foo');
+    isa_ok($bar->foo, 'Foo::Autoloaded');
+
+    # change the value ...
+
+    $bar->foo->bar(30);
+
+    # and make sure the delegation picks it up
+
+    is($bar->foo->bar, 30, '... bar->foo->bar returned the right (changed) value');
+    is($bar->foo_bar, 30, '... bar->foo_bar delegated correctly');
+
+    # change the value through the delegation ...
+
+    $bar->foo_bar(50);
+
+    # and make sure everyone sees it
+
+    is($bar->foo->bar, 50, '... bar->foo->bar returned the right (changed) value');
+    is($bar->foo_bar, 50, '... bar->foo_bar delegated correctly');
+
+    # change the object we are delegating too
+
+    my $foo = Foo::Autoloaded->new;
+    isa_ok($foo, 'Foo::Autoloaded');
+
+    $foo->bar(25);
+
+    is($foo->bar, 25, '... got the right foo->bar');
+
+    local $@;
+    eval { $bar->foo($foo) };
+    is($@, '', '... assigned the new Foo to Bar->foo' );
+
+    is($bar->foo, $foo, '... assigned bar->foo with the new Foo');
+
+    is($bar->foo->bar, 25, '... bar->foo->bar returned the right result');
+    is($bar->foo_bar, 25, '... and bar->foo_bar delegated correctly again');
+}
+
+# check ARRAY based delegation w/ AUTOLOAD
+
+{
+    my $baz = Baz::Autoloaded->new;
+    isa_ok($baz, 'Baz::Autoloaded');
+
+    ok($baz->foo, '... we have something in baz->foo');
+    isa_ok($baz->foo, 'Foo::Autoloaded');
+
+    # change the value ...
+
+    $baz->foo->bar(30);
+
+    # and make sure the delegation picks it up
+
+    is($baz->foo->bar, 30, '... baz->foo->bar returned the right (changed) value');
+    is($baz->bar, 30, '... baz->foo_bar delegated correctly');
+
+    # change the value through the delegation ...
+
+    $baz->bar(50);
+
+    # and make sure everyone sees it
+
+    is($baz->foo->bar, 50, '... baz->foo->bar returned the right (changed) value');
+    is($baz->bar, 50, '... baz->foo_bar delegated correctly');
+
+    # change the object we are delegating too
+
+    my $foo = Foo::Autoloaded->new;
+    isa_ok($foo, 'Foo::Autoloaded');
+
+    $foo->bar(25);
+
+    is($foo->bar, 25, '... got the right foo->bar');
+
+    is( exception {
+        $baz->foo($foo);
+    }, undef, '... assigned the new Foo to Baz->foo' );
+
+    is($baz->foo, $foo, '... assigned baz->foo with the new Foo');
+
+    is($baz->foo->bar, 25, '... baz->foo->bar returned the right result');
+    is($baz->bar, 25, '... and baz->foo_bar delegated correctly again');
+}
+
+# Make sure that a useful error message is thrown when the delegation target is
+# not an object
+{
+    my $i = Bar->new(foo => undef);
+    local $@;
+    eval { $i->foo_bar };
+    like($@, qr/is not defined/, 'useful error from unblessed reference' );
+
+    my $j = Bar->new(foo => []);
+    local $@;
+    eval { $j->foo_bar };
+    like($@, qr/is not an object \(got 'ARRAY/, 'useful error from unblessed reference' );
+
+    my $k = Bar->new(foo => "Foo");
+    local $@;
+    eval { $k->foo_baz };
+    is( $@, '', "but not for class name" );
+}
+
+{
+    package Delegator;
+    use Mo qw(is required handles default builder);
+
+    sub full { 1 }
+    sub stub;
+
+    local $@;
+    eval {
+       has d1 => (
+                isa     => 'X',
+                handles => ['full'],
+            );
+    };
+    ::like(
+        $@,
+        qr/\QYou cannot overwrite a locally defined method (full) with a delegation/,
+        'got an error when trying to declare a delegation method that overwrites a local method'
+    );
+
+    local $@;
+    eval { has d2 => (
+                isa     => 'X',
+                handles => ['stub'],
+            );
+    };
+    ::is(
+        $@,
+        '',
+        'no error when trying to declare a delegation method that overwrites a stub method'
+    );
+}
+

t/lib/Mo/init_arg.t

@@ -0,0 +1,91 @@
+#!/usr/bin/perl
+
+BEGIN {
+   die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n"
+      unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH};
+   unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib";
+};
+
+use strict;
+use warnings FATAL => 'all';
+use English qw(-no_match_vars);
+use Test::More;
+
+
+
+{
+    package Foo;
+    use Mo qw( is init_arg );
+
+    eval {
+        has 'foo' => (
+            is => "rw",
+            init_arg => undef,
+        );
+    };
+    ::ok(!$@, '... created the attr okay');
+}
+
+{
+    my $foo = Foo->new( foo => "bar" );
+    isa_ok($foo, 'Foo');
+
+    is( $foo->foo, undef, "field is not set via init arg" );
+
+    $foo->foo("blah");
+
+    is( $foo->foo, "blah", "field is set via setter" );
+}
+
+{
+    package Foo;
+
+    eval {
+        has 'foo2' => (
+            is => "rw",
+            init_arg => undef,
+        );
+    };
+    ::ok(!$@, '... adding a second attribute with init_arg works');
+}
+
+{
+    my $foo = Foo->new( foo => "bar", foo2 => "baz" );
+
+    is( $foo->foo, undef, "foo is not set via init arg" );
+    is( $foo->foo2, undef, "foo2 is not set via init arg" );
+
+    $foo->foo("blah");
+    $foo->foo2("bluh");
+
+    is( $foo->foo, "blah", "foo is set via setter" );
+    is( $foo->foo2, "bluh", "foo2 is set via setter" );
+}
+
+{
+    package Foo2;
+    use Mo qw( is init_arg clearer default );
+
+    my $counter;
+    eval {
+        has 'auto_foo' => (
+            is       => "ro",
+            init_arg => undef,
+            default  => sub { $counter++ ? "Foo" : "Bar" },
+            clearer  => 'clear_auto_foo',
+        );
+    };
+    ::ok(!$@, '... attribute with init_arg+default+clearer+is works');
+}
+
+{
+    my $foo = Foo2->new( auto_foo => 1234 );
+
+    is( $foo->auto_foo, "Bar", "auto_foo is not set via init arg, but by the default" );
+
+    $foo->clear_auto_foo();
+
+    is( $foo->auto_foo, "Foo", "auto_foo calls default again if cleared" );
+}
+
+done_testing;

t/lib/Mo/is.t

@@ -0,0 +1,26 @@
+#!/usr/bin/perl
+
+BEGIN {
+   die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n"
+      unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH};
+   unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib";
+};
+
+use strict;
+use warnings FATAL => 'all';
+use English qw(-no_match_vars);
+use Test::More;
+
+plan tests => 2;
+
+package Foo::is;
+use Mo qw(is);
+
+has 'stuff' => (is => 'ro');
+
+package main;
+
+my $f = Foo::is->new(stuff => 'foo');
+is $f->stuff, 'foo', 'values passed to constructor are successfully accepted';
+eval { $f->stuff('barbaz') };
+ok $@, 'setting values after initialization throws an exception';

t/lib/Mo/isa.t

@@ -0,0 +1,121 @@
+#!/usr/bin/perl
+
+BEGIN {
+   die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n"
+      unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH};
+   unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib";
+};
+
+use strict;
+use warnings FATAL => 'all';
+use English qw(-no_match_vars);
+use Test::More tests => 80;
+
+sub dies_ok (&;$) {
+  my $code = shift;
+  my $name = shift;
+
+  ok( !eval{ $code->() }, $name )
+      or diag( "expected an exception but none was raised" );
+}
+
+sub lives_ok (&;$) {
+  my $code = shift;
+  my $name = shift;
+
+  eval{ $code->() };
+  is($@, '', $name );
+}
+
+package Foo::isa;
+use Mo qw(isa);
+
+my @types = qw(Bool Num Int Str ArrayRef CodeRef HashRef RegexpRef);
+my @refs = ([], sub { }, {}, qr( ));
+has( "my$_" => ( isa => $_ ) ) for @types;
+has( myFoo => ( isa => "Foo::isa" ) );
+
+package main;
+
+my $foo = Foo::isa->new( myStr => "abcdefg" );
+
+# Bool:
+lives_ok { ok !$foo->myBool(undef) } "Bool attr set to undef";
+lives_ok { is $foo->myBool(1), 1 }   "Bool attr set to 1";
+is $foo->myBool, 1, "new value of \$foo->myBool as expected";
+lives_ok { is $foo->myBool(1e0), 1 } "Bool attr set to 1e0";
+dies_ok { $foo->myBool("1f0") }       "Bool attr set to 1f0 dies";
+lives_ok { is $foo->myBool(""), "" } "Bool attr set to empty string";
+is $foo->myBool, "", "new value of \$foo->myBool as expected";
+lives_ok { is $foo->myBool(0), 0 }   "Bool attr set to 0";
+lives_ok { is $foo->myBool(0.0), 0 } "Bool attr set to 0.0";
+lives_ok { is $foo->myBool(0e0), 0 } "Bool attr set to 0e0";
+dies_ok { $foo->myBool("0.0") }       "Bool attr set to stringy 0.0 dies";
+
+# Bool tests from Mouse:
+open(my $FH, "<", $0) or die "Could not open $0 for the test";
+my $msg = q(Bool rejects anything which is not a 1 or 0 or "" or undef");
+lives_ok { $foo->myBool(0) }              $msg;
+lives_ok { $foo->myBool(1) }              $msg;
+dies_ok { $foo->myBool(100) }             $msg;
+lives_ok { $foo->myBool("") }             $msg;
+dies_ok { $foo->myBool("Foo") }           $msg;
+dies_ok { $foo->myBool([]) }              $msg;
+dies_ok { $foo->myBool({}) }              $msg;
+dies_ok { $foo->myBool(sub {}) }          $msg;
+dies_ok { $foo->myBool(\"") }             $msg;
+dies_ok { $foo->myBool(*STDIN) }          $msg;
+dies_ok { $foo->myBool(\*STDIN) }         $msg;
+dies_ok { $foo->myBool($FH) }             $msg;
+dies_ok { $foo->myBool(qr/../) }          $msg;
+dies_ok { $foo->myBool(bless {}, "Foo") } $msg;
+lives_ok { $foo->myBool(undef) }          $msg;
+
+# Num:
+lives_ok { is $foo->myNum(5.5), 5.5 } "Num attr set to decimal";
+is $foo->myNum, 5.5, "new value of \$foo->myNum as expected";
+lives_ok { is $foo->myNum(5), 5 } "Num attr set to integer";
+lives_ok { is $foo->myNum(5e0), 5 } "Num attr set to 5e0";
+dies_ok { $foo->myBool("5f0") }       "Bool attr set to 5f0 dies";
+lives_ok { is $foo->myNum("5.5"), 5.5 } "Num attr set to stringy decimal";
+
+# Int:
+lives_ok { is $foo->myInt(0), 0 }   "Int attr set to 0";
+lives_ok { is $foo->myInt(1), 1 }   "Int attr set to 1";
+lives_ok { is $foo->myInt(1e0), 1 } "Int attr set to 1e0";
+is $foo->myInt, 1, "new value of \$foo->myInt as expected";
+dies_ok { $foo->myInt("") } "Int attr set to empty string dies";
+dies_ok { $foo->myInt(5.5) } "Int attr set to decimal dies";
+
+# Str:
+is $foo->myStr, "abcdefg", "Str passed to constructor accepted";
+lives_ok { is $foo->myStr("hijklmn"), "hijklmn" } "Str attr set to a string";
+is $foo->myStr, "hijklmn", "new value of \$foo->myStr as expected";
+lives_ok { is $foo->myStr(5.5), 5.5 } "Str attr set to a decimal value";
+
+# Class instance:
+lives_ok { is $foo->myFoo($foo), $foo } "Class instance attr set to self";
+isa_ok $foo->myFoo, "Foo::isa", "new value of \$foo->myFoo as expected";
+dies_ok { $foo->myFoo({}) } "Class instance attr set to hash dies";
+
+# Class name:
+my $class = ref($foo);
+lives_ok { is $foo->myFoo($class), $class } "Class instance attr set to classname";
+is $foo->myFoo, $class, "new value of \$foo->myFoo as expected";
+
+# Refs:
+for my $i (4..7) {
+    my $method = "my" . $types[$i];
+    lives_ok(
+        sub { $foo->$method($refs[$i - 4]) },
+        "$types[$i] attr set to correct reference type" ); }
+for my $i (4..7) {
+    my $method = "my" . $types[$i];
+    dies_ok(
+        sub { $foo->$method($refs[(3 + $i) % 4]) },
+        "$types[$i] attr set to incorrect reference type dies" ); }
+
+# All but Bool vs undef:
+for my $type (@types[1..$#types]) {
+    my $method = "my$type";
+    dies_ok { $foo->$method(undef) } "$type attr set to undef dies" }

t/lib/Mo/object.t

@@ -0,0 +1,18 @@
+#!/usr/bin/perl
+
+BEGIN {
+   die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n"
+      unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH};
+   unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib";
+};
+
+use strict;
+use warnings FATAL => 'all';
+use English qw(-no_match_vars);
+use Test::More tests => 2;
+use lib "$ENV{PERCONA_TOOLKIT_BRANCH}/t/lib/Mo";
+
+{ package Clean; use Foo; }
+
+is_deeply([ @Clean::ISA ], [], "Didn't mess with caller's ISA");
+is(Clean->can('has'), undef, "Didn't export anything");

t/lib/Mo/required.t

@@ -0,0 +1,39 @@
+#!/usr/bin/perl
+
+BEGIN {
+   die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n"
+      unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH};
+   unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib";
+};
+
+use strict;
+use warnings FATAL => 'all';
+use English qw(-no_match_vars);
+use Test::More;
+
+plan tests => 3;
+
+#============
+package Foo::required;
+use Mo qw(required);
+
+has 'stuff' => (required => 1);
+has 'stuff2' => (required => 1);
+has 'foo' => ();
+#============
+package Foo::required_is;
+use Mo qw(required);
+
+has 'stuff' => (required => 1, is => 'ro');
+#============
+
+package main;
+
+my $f0 = eval { Foo::required->new(stuff2 => 'foobar') };
+like $@, qr/^\QAttribute (stuff) is required/, 'Mo dies when a required value is not provided';
+
+my $f = Foo::required->new(stuff => 'fubar', stuff2 => 'foobar');
+is $f->stuff, 'fubar', 'Object is correctly initialized when required values are provided';
+
+my $f2 = Foo::required_is->new(stuff => 'fubar');
+is $f2->stuff, 'fubar', 'Object is correctly initialized when required is combined with is';

t/lib/Mo/strict.t

@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+BEGIN {
+   die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n"
+      unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH};
+   unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib";
+};
+
+use strict;
+use warnings FATAL => 'all';
+use English qw(-no_match_vars);
+use Test::More tests => 1;
+
+eval 'package Foo; use Mo; $x = 1';
+
+like $@, qr/Global symbol "\$x" requires explicit package name/,
+    'Mo is strict';

t/lib/Mo/test.t

@@ -0,0 +1,140 @@
+#!/usr/bin/perl
+
+BEGIN {
+   die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n"
+      unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH};
+   unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib";
+};
+
+use strict;
+use warnings FATAL => 'all';
+use English qw(-no_match_vars);
+use Test::More;
+
+plan tests => 39;
+
+#============
+package Foo;
+use Mo;
+
+has 'this';
+
+#============
+package main;
+
+ok defined(&Foo::has), 'Mo exports has';
+ok defined(&Foo::extends), 'Mo exports extends';
+ok not(defined(&Foo::new)), 'Mo does not export new';
+ok 'Foo'->isa('Mo::Object'), 'Foo isa Mo::Object';
+is "@Foo::ISA", "Mo::Object", '@Foo::ISA is Mo::Object';
+ok 'Foo'->can('new'), 'Foo can new';
+ok 'Foo'->can('this'), 'Foo can this';
+
+my $f = 'Foo'->new;
+
+ok not(exists($f->{this})), 'this does not exist';
+ok not(defined($f->this)), 'this is not defined';
+
+$f->this("it");
+
+is $f->this, 'it', 'this is it';
+is $f->{this}, 'it', '{this} is it';
+
+$f->this("that");
+
+is $f->this, 'that', 'this is that';
+is $f->{this}, 'that', '{this} is that';
+
+$f->this(undef);
+
+ok not(defined($f->this)), 'this is not defined';
+ok not(defined($f->{this})), '{this} is not defined';
+
+#============
+package Bar;
+use Mo 'builder', 'default';
+extends 'Foo';
+
+has 'that';
+has them => default => sub {[]};
+has plop => (
+    is => 'xy',
+    default => sub { my $self = shift; "plop: " . $self->that },
+);
+has 'plip';
+has bridge => builder => 'bridge_builder';
+use constant bridge_builder => 'A Bridge';
+has guess => (
+    default => sub {'me me me'},
+    builder => 'bridge_builder',
+);
+
+#============
+package main;
+
+ok 'Bar'->isa('Mo::Object'), 'Bar isa Mo::Object';
+ok 'Bar'->isa('Foo'), 'Bar isa Foo';
+is "@Bar::ISA", 'Foo', '@Bar::ISA is Foo';
+ok 'Bar'->can('new'), 'Bar can new';
+ok 'Bar'->can('this'), 'Bar can this';
+ok 'Bar'->can('that'), 'Bar can that';
+ok 'Bar'->can('them'), 'Bar can them';
+
+my $b = Bar->new(
+    this => 'thing',
+    that => 'thong',
+);
+
+is ref($b), 'Bar', 'Object created';
+ok $b->isa('Foo'), 'Inheritance works';
+ok $b->isa('Mo::Object'), 'Bar isa Mo::Object since Foo isa Mo::Object';
+is $b->this, 'thing', 'Read works in parent class';
+is $b->that, 'thong', 'Read works in current class';
+is ref($b->them), 'ARRAY', 'default works';
+is $b->plop, 'plop: thong', 'default works as a method call';
+$b->that("thung");
+$b->plop(undef);
+ok not(defined $b->plop), 'plop is undef';
+delete $b->{plop};
+is $b->plop, 'plop: thung', 'default works again';
+$b->that("thyng");
+is $b->plop, 'plop: thung', 'default works again';
+is $b->plip, undef, 'no default is undef';
+is $b->bridge, 'A Bridge', 'builder works';
+is $b->guess, 'me me me', 'default trumps builder';
+
+#============
+package Baz;
+use Mo 'build';
+
+has 'foo';
+
+sub BUILD {
+    my $self = shift;
+    $self->foo(5);
+}
+
+#============
+package Maz;
+use Mo;
+extends 'Baz';
+
+has 'bar';
+
+sub BUILD {
+    my $self = shift;
+    $self->SUPER::BUILD();
+    $self->bar(7);
+}
+
+#============
+package main;
+
+my $baz = Baz->new;
+is $baz->foo, 5, 'BUILD works';
+
+$_ = 5;
+my $maz = Maz->new;
+is $_, 5, '$_ is untouched';
+is $maz->foo, 5, 'BUILD works again';
+is $maz->bar, 7, 'BUILD works in parent class';