File: test.t

package info (click to toggle)
percona-toolkit 3.2.1-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye, forky, sid, trixie
  • size: 68,916 kB
  • sloc: perl: 241,287; sql: 22,868; sh: 19,746; javascript: 6,799; makefile: 353; awk: 38; python: 30; sed: 1
file content (140 lines) | stat: -rw-r--r-- 3,171 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
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;