percona-toolkit/t/lib/Lmo/meta.t

#!/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;