mirror of
https://github.com/percona/percona-toolkit.git
synced 2025-10-18 16:40:23 +00:00
Remove .moved files.
This commit is contained in:
@@ -1,83 +0,0 @@
|
|||||||
#!/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;
|
|
@@ -1,72 +0,0 @@
|
|||||||
#!/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;
|
|
@@ -1,28 +0,0 @@
|
|||||||
#!/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;
|
|
Reference in New Issue
Block a user