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
|
#!/usr/bin/perl -w
use strict;
use Test::More tests => 31;
use Test::Fatal;
use Test::Refcount;
use IO::Async::Notifier;
use IO::Async::Loop;
my $parent = TestNotifier->new( varref => \my $parent_in_loop );
my $child = TestNotifier->new( varref => \my $child_in_loop );
is_oneref( $parent, '$parent has refcount 1 initially' );
is_oneref( $child, '$child has refcount 1 initially' );
$parent->add_child( $child );
is( $child->parent, $parent, '$child->parent is $parent' );
ok( !$parent_in_loop, '$parent not yet in loop' );
ok( !$child_in_loop, '$child not yet in loop' );
my @children;
@children = $parent->children;
is( scalar @children, 1, '@children after add_child' );
is( $children[0], $child, '$children[0] after add_child' );
undef @children; # for refcount
is_oneref( $parent, '$parent has refcount 1 after add_child' );
is_refcount( $child, 2, '$child has refcount 2 after add_child' );
ok( exception { $parent->add_child( $child ) }, 'Adding child again fails' );
$parent->remove_child( $child );
is_oneref( $child, '$child has refcount 1 after remove_child' );
@children = $parent->children;
is( scalar @children, 0, '@children after remove_child' );
undef @children; # for refcount
my $loop = IO::Async::Loop->new;
$loop->add( $parent );
$parent->add_child( $child );
is_refcount( $child, 3, '$child has refcount 3 after add_child within loop' );
is( $parent->loop, $loop, '$parent->loop is $loop' );
is( $child->loop, $loop, '$child->loop is $loop' );
ok( $parent_in_loop, '$parent now in loop' );
ok( $child_in_loop, '$child now in loop' );
ok( exception { $loop->remove( $child ) }, 'Directly removing a child from the loop fails' );
$loop->remove( $parent );
@children = $parent->children;
is( scalar @children, 1, '@children after removal from loop' );
undef @children; # for refcount
is_oneref( $parent, '$parent has refcount 1 after removal from loop' );
is_refcount( $child, 2, '$child has refcount 2 after removal of parent from loop' );
is( $parent->loop, undef, '$parent->loop is undef' );
is( $child->loop, undef, '$child->loop is undef' );
ok( !$parent_in_loop, '$parent no longer in loop' );
ok( !$child_in_loop, '$child no longer in loop' );
ok( exception { $loop->add( $child ) }, 'Directly adding a child to the loop fails' );
$loop->add( $parent );
is( $child->loop, $loop, '$child->loop is $loop after remove/add parent' );
ok( $parent_in_loop, '$parent now in loop' );
ok( $child_in_loop, '$child now in loop' );
$loop->remove( $parent );
$parent->remove_child( $child );
is_oneref( $parent, '$parent has refcount 1 finally' );
is_oneref( $child, '$child has refcount 1 finally' );
package TestNotifier;
use base qw( IO::Async::Notifier );
sub new
{
my $self = shift->SUPER::new;
my %params = @_;
$self->{varref} = $params{varref};
return $self;
}
sub _add_to_loop
{
my $self = shift;
${ $self->{varref} } = 1;
}
sub _remove_from_loop
{
my $self = shift;
${ $self->{varref} } = 0;
}
|
