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
|
#!perl
use Test::More tests => 5;
package first;
use common::sense;
use base qw/Object::Event/;
sub test2 : event_cb {
my ($self, $a) = @_;
push @{$self->{chain}}, 'first::test2';
}
sub test3 : event_cb {
my ($self) = @_;
push @{$self->{chain}}, 'first::test3';
}
package pre;
use common::sense;
use base qw/first/;
sub test2 : event_cb {
my ($self, $a) = @_;
push @{$self->{chain}}, 'pre::test2';
}
package foo;
use common::sense;
use base qw/Object::Event/;
sub test : event_cb {
my ($self, $a, $b) = @_;
push @{$self->{chain}}, 'foo::test';
}
package bar;
use common::sense;
use base qw/foo pre/;
sub test : event_cb {
my ($self, $a, $b) = @_;
push @{$self->{chain}}, 'bar::test';
}
sub test2 : event_cb {
my ($self, $a) = @_;
push @{$self->{chain}}, 'bar::test2';
}
package main;
use common::sense;
my $f = foo->new;
my $b = bar->new;
$b->test2 (100);
is ((join ",", @{delete $b->{chain}}), 'first::test2,pre::test2,bar::test2', 'bar first class works.');
$b->test3 (200);
is ((join ",", @{delete $b->{chain}}), 'first::test3', 'bar first undecl class works.');
$f->reg_cb (before_test => sub {
my ($f) = @_;
push @{$f->{chain}}, 'f::before_test';
});
$b->reg_cb (before_test => sub {
my ($f) = @_;
push @{$f->{chain}}, 'b::before_test';
});
$b->reg_cb (test2 => sub {
my ($f) = @_;
push @{$f->{chain}}, 'b::test2';
});
$f->test (10, 20);
is ((join ",", @{delete $f->{chain}}), 'f::before_test,foo::test', 'foo class works.');
$b->test (10, 20);
is ((join ",", @{delete $b->{chain}}), 'b::before_test,foo::test,bar::test', 'bar class works.');
$b->test2 (100);
is ((join ",", @{delete $b->{chain}}), 'first::test2,pre::test2,bar::test2,b::test2', 'bar class works.');
|
