Merged use-lmo.

This commit renames our fork of Mo to Lmo, since the two have diverged
a huge deal. The merged branch streamlined Lmo a great deal as well,
for maintainability.

t/lib/Lmo/Bar.pm

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

t/lib/Lmo/Boo.pm

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

t/lib/Lmo/Foo.pm

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

t/lib/Lmo/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 Lmo 'build';
+has 'foo' => (is => 'rw');
+sub BUILD {
+    my $self = shift;
+    ::is_deeply([sort @_], [sort qw(stuff 1)], "Foo's BUILD doesn't get the class name");
+    $self->foo($main::count++);
+}
+
+package Bar;
+use Lmo;
+extends 'Foo';
+has 'bar' => (is => 'rw');
+
+package Baz;
+use Lmo;
+extends 'Bar';
+has 'baz' => (is => 'rw');
+sub BUILD {
+    my $self = shift;
+    ::is_deeply([sort @_], [sort qw(stuff 1)], "Baz's BUILD doesn't get the class name");
+    $self->baz($main::count++);
+}
+
+package Gorch;
+use Lmo;
+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/Lmo/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 Lmo;
+   has nothing_special => ( is => 'rw' );
+}
+ok(Nothing->can("BUILDARGS"), "Every class automatically gets buildargs");
+
+package Foo;
+use Lmo;
+has 'foo' => (is => 'rw');
+sub BUILDARGS {
+    my $class = shift;
+    $main::count++;
+    $class->SUPER::BUILDARGS(@_);
+}
+
+package Bar;
+use Lmo;
+extends 'Foo';
+has 'bar' => (is => 'rw');
+
+package Baz;
+use Lmo;
+extends 'Bar';
+has 'baz' => (is => 'rw');
+sub BUILDARGS {
+    my $class = shift;
+    $main::count++;
+    $class->SUPER::BUILDARGS(@_)
+}
+
+package Gorch;
+use Lmo;
+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 Lmo::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/Lmo/coerce.t

@@ -0,0 +1,27 @@
+#!/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::coerce;
+use Lmo;
+
+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';
+
+
+done_testing;

t/lib/Lmo/extends.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;
+
+use lib "$ENV{PERCONA_TOOLKIT_BRANCH}/t/lib/Lmo";
+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';
+
+done_testing;

t/lib/Lmo/handles.t

@@ -0,0 +1,482 @@
+#!/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;
+
+
+# -------------------------------------------------------------------
+# 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 Lmo qw(is required handles default builder);
+
+    has 'bar' => (is => 'rw', default => sub { 10 });
+
+    sub baz { 42 }
+
+    package Bar;
+    use Lmo 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 Lmo qw(is required handles default builder);
+
+    sub go   { 'Engine::go'   }
+    sub stop { 'Engine::stop' }
+
+    package Car;
+    use Lmo 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 Lmo qw(is required handles default builder);
+
+    sub foo { 'Baz::foo' }
+    sub bar { 'Baz::bar' }
+    sub boo { 'Baz::boo' }
+
+    package Baz::Proxy1;
+    use Lmo qw(is required handles default builder);
+
+    has 'baz' => (
+        is      => 'ro',
+        isa     => 'Baz',
+        default => sub { Baz->new },
+        handles => qr/.*/
+    );
+
+    package Baz::Proxy2;
+    use Lmo qw(is required handles default builder);
+
+    has 'baz' => (
+        is      => 'ro',
+        isa     => 'Baz',
+        default => sub { Baz->new },
+        handles => qr/.oo/
+    );
+
+    package Baz::Proxy3;
+    use Lmo 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', '... ->foo got the right proxied return value');
+    is($baz_proxy->bar, 'Baz::bar', '... ->bar got the right proxied return value');
+    is($baz_proxy->boo, 'Baz::boo', '... ->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', '... ->foo got the right proxied return value');
+    is($baz_proxy->boo, 'Baz::boo', '... ->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', '... ->bar got the right proxied return value');
+    is($baz_proxy->boo, 'Baz::boo', '... ->boo got the right proxied return value');
+}
+
+# -------------------------------------------------------------------
+# ROLE handles
+# -------------------------------------------------------------------
+=begin
+{
+    package Foo::Bar;
+    use Moose::Role;
+
+    requires 'foo';
+    requires 'bar';
+
+    package Foo::Baz;
+    use Lmo 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 Lmo qw(is required handles default builder);
+
+    has 'thing' => (
+        is      => 'rw',
+        isa     => 'Foo::Baz',
+        handles => 'Foo::Bar',
+    );
+
+    package Foo::OtherThing;
+    use Lmo 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 Lmo 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 Lmo qw(is required handles default builder);
+
+    has 'foo' => (
+        is      => 'rw',
+        default => sub { Foo::Autoloaded->new },
+        handles => { 'foo_bar' => 'bar' }
+    );
+
+    package Baz::Autoloaded;
+    use Lmo qw(is required handles default builder);
+
+    has 'foo' => (
+        is      => 'rw',
+        default => sub { Foo::Autoloaded->new },
+        handles => ['bar']
+    );
+
+    package Goorch::Autoloaded;
+    use Lmo 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 value changed by ->foo->bar()');
+    is($bar->foo_bar, 30, '... bar->foo_bar getter 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 value changed by ->foo_bar()');
+    is($bar->foo_bar, 50, '... bar->foo_bar getter 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 if delegating from undef' );
+
+    my $j = Bar->new(foo => []);
+    local $@;
+    eval { $j->foo_bar };
+    like($@, qr/is not an object \(got 'ARRAY/, '... or from an unblessed reference' );
+
+    my $k = Bar->new(foo => "Foo");
+    local $@;
+    eval { $k->foo_baz };
+    is( $@, '', "but not for class name" );
+}
+
+{
+    package Delegator;
+    use Lmo 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'
+    );
+}
+
+
+done_testing;

t/lib/Lmo/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 Lmo 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 Lmo 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/Lmo/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;
+
+package Foo::is;
+use Lmo 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';
+
+done_testing;

t/lib/Lmo/isa.t

@@ -0,0 +1,201 @@
+#!/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 PerconaTest ();
+use Test::More;
+
+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 Lmo 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 !defined($foo->myBool(undef)),
+      "myBool set to undef"
+} "Bool attr set to undef";
+lives_ok {
+   is $foo->myBool(1), 1,
+      "myBool set to 1"
+}   "Bool attr set to 1";
+is $foo->myBool, 1, "new value of \$foo->myBool as expected";
+lives_ok {
+   is $foo->myBool(1e0), 1,
+      "myBool set to 1e0 becomes 1"
+} "Bool attr set to 1e0";
+dies_ok { $foo->myBool("1f0") }       "Bool attr set to 1f0 dies";
+lives_ok {
+   is $foo->myBool(""), "",
+      "myBool set to an emptry string"
+} "Bool attr set to empty string";
+is $foo->myBool, "", "new value of \$foo->myBool as expected";
+lives_ok {
+   is $foo->myBool(0), 0,
+      "myBool set to 0"
+}   "Bool attr set to 0";
+lives_ok {
+   is $foo->myBool(0.0), 0,
+      "myBool set to 0.0 becomes 0"
+} "Bool attr set to 0.0";
+lives_ok {
+   is $foo->myBool(0e0), 0,
+      "myBool set to 0e0 becomes 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";
+# Bool rejects anything which is not a 1 or 0 or "" or undef:
+lives_ok { $foo->myBool(0) }              "Bool lives with 0";
+lives_ok { $foo->myBool(1) }              "Bool lives with 1";
+dies_ok { $foo->myBool(100) }             "Bool dies with 100";
+lives_ok { $foo->myBool("") }             "Bool lives with ''";
+dies_ok { $foo->myBool("Foo") }           "Bool dies with a string";
+dies_ok { $foo->myBool([]) }              "Bool dies with an arrayref";
+dies_ok { $foo->myBool({}) }              "Bool dies with a hashref";
+dies_ok { $foo->myBool(sub {}) }          "Bool dies with a coderef";
+dies_ok { $foo->myBool(\"") }             "Bool dies with a scalar ref";
+dies_ok { $foo->myBool(*STDIN) }          "Bool dies with a glob";
+dies_ok { $foo->myBool(\*STDIN) }         "Bool dies with a globref";
+dies_ok { $foo->myBool($FH) }             "Bool dies with a lexical filehandle";
+dies_ok { $foo->myBool(qr/../) }          "Bool dies with a regex";
+dies_ok { $foo->myBool(bless {}, "Foo") } "Bool dies with an object";
+lives_ok { $foo->myBool(undef) }          "Bool lives with undef";
+
+# Num:
+lives_ok {
+   is $foo->myNum(5.5),
+      5.5,
+      "myNum was set to 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,
+      "myNum was set to 5"
+} "Num attr set to integer";
+lives_ok {
+   is $foo->myNum(5e0),
+      5,
+      "myNum was set to 5e0"
+} "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,
+      "myNum was set to q<5.5>"
+} "Num attr set to stringy decimal";
+
+# Int:
+lives_ok {
+   is $foo->myInt(0),
+      0,
+      "myInt was set to 0"
+}   "Int attr set to 0";
+lives_ok {
+   is $foo->myInt(1),
+      1,
+      "myInt was set to 1"
+}   "Int attr set to 1";
+lives_ok {
+   is $foo->myInt(1e0),
+      1,
+      "myInt was set to 1e0"
+} "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",
+      "myStr was set to a string",
+} "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,
+      "myStr was set to 5.5"
+} "Str attr set to a decimal value";
+
+# Class instance:
+lives_ok {
+   is $foo->myFoo($foo), $foo,
+      "myFoo set to self"
+} "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,
+      "myFoo set to a classname"   
+} "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" }
+
+
+use Config;
+use File::Spec;
+use IPC::Cmd ();
+my $thisperl = $^X;
+if ($^O ne 'VMS')
+   {$thisperl .= $Config{_exe} unless $thisperl =~ m/$Config{_exe}$/i;}
+
+my $pm_test = "$PerconaTest::trunk/t/lib/Lmo/isa_subtest.pm";
+   
+ok(
+   scalar(IPC::Cmd::run(command => [$thisperl, $pm_test])),
+   "Lmo types work with Scalar::Util::PP",
+);
+
+done_testing;

t/lib/Lmo/isa_subtest.pm

@@ -0,0 +1,29 @@
+BEGIN {
+   # If we can't load ::PP, the bug can't happen on this perl, so it's a pass
+   eval { require Scalar::Util::PP } or do { exit 0 };
+   *Scalar::Util:: = \*Scalar::Util::PP::;
+   $INC{"Scalar/Util.pm"} = __FILE__;
+};
+
+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;
+
+{
+   package isa_subtest;
+   use Lmo;
+
+   has attr => (
+      is  => 'rw',
+      isa => 'Int',
+   );
+
+   1;
+}
+
+isa_subtest->new(attr => 100);

t/lib/Lmo/meta.t

@@ -0,0 +1,83 @@
+#!/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;
+
+sub throws_ok (&;$) {
+   my ( $code, $pat, $msg ) = @_;
+   eval { $code->(); };
+   like ( $EVAL_ERROR, $pat, $msg );
+}
+
+{
+   package Metatest;
+   use Lmo;
+
+   has stuff => ( is => 'rw', required => 1 );
+   has init_stuff1 => ( is => 'rw', init_arg => undef );
+   has init_stuff2 => ( is => 'rw', init_arg => 'fancy_name' );
+}
+{
+package Metatest::child;
+   use Lmo;
+   extends 'Metatest';
+
+   has more_stuff => ( is => 'rw' );
+}
+
+my $obj = Metatest->new( stuff => 100 );
+
+can_ok($obj, 'meta');
+
+my $meta = $obj->meta();
+
+is_deeply(
+   [ sort $meta->attributes ],
+   [ sort qw(stuff init_stuff1 init_stuff2) ],
+   "->attributes works"
+);
+
+is_deeply(
+   [ sort $meta->attributes_for_new ],
+   [ sort qw(stuff fancy_name) ],
+   "->attributes_for_new works"
+);
+
+# Do these BEFORE initializing ::extends
+my $meta2 = Metatest::child->meta();
+is_deeply(
+   [ sort $meta2->attributes ],
+   [ sort qw(stuff init_stuff1 init_stuff2 more_stuff) ],
+   "->attributes works on a child class"
+);
+
+is_deeply(
+   [ sort $meta2->attributes_for_new ],
+   [ sort qw(stuff fancy_name more_stuff) ],
+   "->attributes_for_new works in a child class"
+);
+
+my $meta3 = Metatest::child->new(stuff => 10)->meta();
+is_deeply(
+   [ sort $meta3->attributes ],
+   [ sort qw(stuff init_stuff1 init_stuff2 more_stuff) ],
+   "->attributes works on an initialized child class"
+);
+
+is_deeply(
+   [ sort $meta3->attributes_for_new ],
+   [ sort qw(stuff fancy_name more_stuff) ],
+   "->attributes_for_new works in an initialized child class"
+);
+
+throws_ok { Metatest::child->new() } qr/\QAttribute (stuff) is required for Metatest::child/;
+
+done_testing;

t/lib/Lmo/meta.t.moved

@@ -0,0 +1,83 @@
+#!/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;
+
+sub throws_ok (&;$) {
+   my ( $code, $pat, $msg ) = @_;
+   eval { $code->(); };
+   like ( $EVAL_ERROR, $pat, $msg );
+}
+
+{
+   package Metatest;
+   use Lmo;
+
+   has stuff => ( is => 'rw', required => 1 );
+   has init_stuff1 => ( is => 'rw', init_arg => undef );
+   has init_stuff2 => ( is => 'rw', init_arg => 'fancy_name' );
+}
+{
+package Metatest::child;
+   use Lmo;
+   extends 'Metatest';
+
+   has more_stuff => ( is => 'rw' );
+}
+
+my $obj = Metatest->new( stuff => 100 );
+
+can_ok($obj, 'meta');
+
+my $meta = $obj->meta();
+
+is_deeply(
+   [ sort $meta->attributes ],
+   [ sort qw(stuff init_stuff1 init_stuff2) ],
+   "->attributes works"
+);
+
+is_deeply(
+   [ sort $meta->attributes_for_new ],
+   [ sort qw(stuff fancy_name) ],
+   "->attributes_for_new works"
+);
+
+# Do these BEFORE initializing ::extends
+my $meta2 = Metatest::child->meta();
+is_deeply(
+   [ sort $meta2->attributes ],
+   [ sort qw(stuff init_stuff1 init_stuff2 more_stuff) ],
+   "->attributes works on a child class"
+);
+
+is_deeply(
+   [ sort $meta2->attributes_for_new ],
+   [ sort qw(stuff fancy_name more_stuff) ],
+   "->attributes_for_new works in a child class"
+);
+
+my $meta3 = Metatest::child->new(stuff => 10)->meta();
+is_deeply(
+   [ sort $meta3->attributes ],
+   [ sort qw(stuff init_stuff1 init_stuff2 more_stuff) ],
+   "->attributes works on an initialized child class"
+);
+
+is_deeply(
+   [ sort $meta3->attributes_for_new ],
+   [ sort qw(stuff fancy_name more_stuff) ],
+   "->attributes_for_new works in an initialized child class"
+);
+
+throws_ok { Metatest::child->new() } qr/\QAttribute (stuff) is required for Metatest::child/;
+
+done_testing;

t/lib/Lmo/object.t

@@ -0,0 +1,20 @@
+#!/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;
+use lib "$ENV{PERCONA_TOOLKIT_BRANCH}/t/lib/Lmo";
+
+{ package Clean; use Foo; }
+
+is_deeply([ @Clean::ISA ], [], "Didn't mess with caller's ISA");
+is(Clean->can('has'), undef, "Didn't export anything");
+
+done_testing;

t/lib/Lmo/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;
+
+#============
+package Foo::required;
+use Lmo qw(required);
+
+has 'stuff' => (required => 1);
+has 'stuff2' => (required => 1);
+has 'foo' => ();
+#============
+package Foo::required_is;
+use Lmo qw(required);
+
+has 'stuff' => (required => 1, is => 'ro');
+#============
+
+package main;
+
+my $f0 = eval { Foo::required->new(stuff2 => 'foobar') };
+like $@, qr/^\QAttribute (stuff) is required/, 'Lmo 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';
+
+done_testing;

t/lib/Lmo/role.t

@@ -0,0 +1,72 @@
+#!/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;
+
+BEGIN {
+   my $have_roles = eval { require Role::Tiny };
+   plan skip_all => "Can't load Role::Tiny, not testing Roles"
+      unless $have_roles;
+}
+
+{
+  package One::P1; use Lmo::Role;
+  has two => (is => 'ro', default => sub { 'two' });
+  no Lmo::Role;
+
+  package One::P2; use Lmo::Role;
+  has three => (is => 'ro', default => sub { 'three' });
+  no Lmo::Role;
+  
+  package One::P3; use Lmo::Role;
+  has four => (is => 'ro', default => sub { 'four' });
+  no Lmo::Role;
+
+  package One; use Lmo;
+  with qw( One::P1 One::P2 );
+  has one => (is => 'ro', default => sub { 'one' });
+}
+
+my $combined = One->new();
+
+ok $combined->does($_), "Does $_" for qw(One::P1 One::P2);
+
+ok !$combined->does($_), "Doesn't $_" for qw(One::P3 One::P4);
+
+is $combined->one, "one",     "attr default set from class";
+is $combined->two, "two",     "attr default set from role";
+is $combined->three, "three", "attr default set from role";
+
+# Testing unimport
+
+{
+   package Two::P1; use Lmo::Role;
+   has two => (is => 'ro', default => sub { 'two' });
+   no Lmo::Role;
+
+   package Two; use Lmo;
+   with qw(Two::P1);
+   has three => ( is => 'ro', default => sub { 'three' } );
+   no Lmo;
+}
+
+my $two = Two->new();
+
+is
+   $two->two(),
+   'two',
+   "unimporting in a role doesn't remove new attributes";
+
+for my $class ( qw( Two::P1 Two ) ) {
+   ok !$class->can($_), "...but does remove $_ from $class" for qw(has with extends requires);
+}
+
+done_testing;

t/lib/Lmo/role.t.moved

@@ -0,0 +1,72 @@
+#!/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;
+
+BEGIN {
+   my $have_roles = eval { require Role::Tiny };
+   plan skip_all => "Can't load Role::Tiny, not testing Roles"
+      unless $have_roles;
+}
+
+{
+  package One::P1; use Lmo::Role;
+  has two => (is => 'ro', default => sub { 'two' });
+  no Lmo::Role;
+
+  package One::P2; use Lmo::Role;
+  has three => (is => 'ro', default => sub { 'three' });
+  no Lmo::Role;
+  
+  package One::P3; use Lmo::Role;
+  has four => (is => 'ro', default => sub { 'four' });
+  no Lmo::Role;
+
+  package One; use Lmo;
+  with qw( One::P1 One::P2 );
+  has one => (is => 'ro', default => sub { 'one' });
+}
+
+my $combined = One->new();
+
+ok $combined->does($_), "Does $_" for qw(One::P1 One::P2);
+
+ok !$combined->does($_), "Doesn't $_" for qw(One::P3 One::P4);
+
+is $combined->one, "one",     "attr default set from class";
+is $combined->two, "two",     "attr default set from role";
+is $combined->three, "three", "attr default set from role";
+
+# Testing unimport
+
+{
+   package Two::P1; use Lmo::Role;
+   has two => (is => 'ro', default => sub { 'two' });
+   no Lmo::Role;
+
+   package Two; use Lmo;
+   with qw(Two::P1);
+   has three => ( is => 'ro', default => sub { 'three' } );
+   no Lmo;
+}
+
+my $two = Two->new();
+
+is
+   $two->two(),
+   'two',
+   "unimporting in a role doesn't remove new attributes";
+
+for my $class ( qw( Two::P1 Two ) ) {
+   ok !$class->can($_), "...but does remove $_ from $class" for qw(has with extends requires);
+}
+
+done_testing;

t/lib/Lmo/strict.t

@@ -0,0 +1,19 @@
+#!/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;
+
+eval 'package Foo; use Lmo; $x = 1';
+
+like $@, qr/Global symbol "\$x" requires explicit package name/,
+    'Lmo is strict';
+
+done_testing;

t/lib/Lmo/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;
+
+#============
+package Foo;
+use Lmo;
+
+has 'this';
+
+#============
+package main;
+
+ok defined(&Foo::has), 'Lmo exports has';
+ok defined(&Foo::extends), 'Lmo exports extends';
+ok not(defined(&Foo::new)), 'Lmo does not export new';
+ok 'Foo'->isa('Lmo::Object'), 'Foo isa Lmo::Object';
+is "@Foo::ISA", "Lmo::Object", '@Foo::ISA is Lmo::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 Lmo '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('Lmo::Object'), 'Bar isa Lmo::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('Lmo::Object'), 'Bar isa Lmo::Object since Foo isa Lmo::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 Lmo 'build';
+
+has 'foo';
+
+sub BUILD {
+    my $self = shift;
+    $self->foo(5);
+}
+
+#============
+package Maz;
+use Lmo;
+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';
+
+done_testing;

t/lib/Lmo/unimport.t

@@ -0,0 +1,28 @@
+#!/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 One; use Lmo;
+   has one => (is => 'ro', default => sub { 'one' });
+   no Lmo;
+}
+
+my $unimported = One->new();
+is
+   $unimported->one(),
+   'one',
+   "after unimporting, ->one still works";
+
+ok !$unimported->can($_), "after unimpoirt, can't $_" for qw(has with extends);
+
+done_testing;

t/lib/Lmo/unimport.t.moved

@@ -0,0 +1,28 @@
+#!/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 One; use Lmo;
+   has one => (is => 'ro', default => sub { 'one' });
+   no Lmo;
+}
+
+my $unimported = One->new();
+is
+   $unimported->one(),
+   'one',
+   "after unimporting, ->one still works";
+
+ok !$unimported->can($_), "after unimpoirt, can't $_" for qw(has with extends);
+
+done_testing;