1#!/usr/bin/perl
2
3BEGIN {
4   die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n"
5      unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH};
6   unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib";
7};
8
9use strict;
10use warnings FATAL => 'all';
11use English qw(-no_match_vars);
12use Test::More;
13
14sub throws_ok (&;$) {
15   my ( $code, $pat, $msg ) = @_;
16   eval { $code->(); };
17   like ( $EVAL_ERROR, $pat, $msg );
18}
19
20{
21   package Metatest;
22   use Lmo;
23
24   has stuff => ( is => 'rw', required => 1 );
25   has init_stuff1 => ( is => 'rw', init_arg => undef );
26   has init_stuff2 => ( is => 'rw', init_arg => 'fancy_name' );
27}
28{
29package Metatest::child;
30   use Lmo;
31   extends 'Metatest';
32
33   has more_stuff => ( is => 'rw' );
34}
35
36my $obj = Metatest->new( stuff => 100 );
37
38can_ok($obj, 'meta');
39
40my $meta = $obj->meta();
41
42is_deeply(
43   [ sort $meta->attributes ],
44   [ sort qw(stuff init_stuff1 init_stuff2) ],
45   "->attributes works"
46);
47
48is_deeply(
49   [ sort $meta->attributes_for_new ],
50   [ sort qw(stuff fancy_name) ],
51   "->attributes_for_new works"
52);
53
54# Do these BEFORE initializing ::extends
55my $meta2 = Metatest::child->meta();
56is_deeply(
57   [ sort $meta2->attributes ],
58   [ sort qw(stuff init_stuff1 init_stuff2 more_stuff) ],
59   "->attributes works on a child class"
60);
61
62is_deeply(
63   [ sort $meta2->attributes_for_new ],
64   [ sort qw(stuff fancy_name more_stuff) ],
65   "->attributes_for_new works in a child class"
66);
67
68my $meta3 = Metatest::child->new(stuff => 10)->meta();
69is_deeply(
70   [ sort $meta3->attributes ],
71   [ sort qw(stuff init_stuff1 init_stuff2 more_stuff) ],
72   "->attributes works on an initialized child class"
73);
74
75is_deeply(
76   [ sort $meta3->attributes_for_new ],
77   [ sort qw(stuff fancy_name more_stuff) ],
78   "->attributes_for_new works in an initialized child class"
79);
80
81throws_ok { Metatest::child->new() } qr/\QAttribute (stuff) is required for Metatest::child/;
82
83done_testing;
84