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
141
142
143
144
145
146
147
148
|
#!/usr/bin/perl
use v5.26;
use warnings;
use Future::AsyncAwait 0.47;
use Test2::V0;
use constant HAVE_TEST_MEMORY_CYCLE => defined eval {
require Test::Memory::Cycle; Test::Memory::Cycle->import;
};
use Tangence::Constants;
use Tangence::Registry;
use Struct::Dumb 0.09; # _forbid_arrayification
use lib ".";
use t::TestObj;
use t::TestServerClient;
### TODO
# This test file relies a lot on weird logic in TestObj. Should probably instead just use
# the object's property manip. methods directly
###
my $registry = Tangence::Registry->new(
tanfile => "t/TestObj.tan",
);
my $obj = $registry->construct(
"t::TestObj",
);
my ( $server, $client ) = make_serverclient( $registry );
my $proxy = $client->rootobj;
my $scalar;
my $scalar_changed = 0;
await $proxy->watch_property_with_initial( "scalar",
on_set => sub {
$scalar = shift;
$scalar_changed = 1
},
);
is( $scalar, "123", 'Initial value from watch_property' );
is( $proxy->prop( "scalar" ),
"123",
"scalar property cache" );
my $hash_changed = 0;
await $proxy->watch_property_with_initial( "hash",
on_updated => sub { $hash_changed = 1 },
);
is( $proxy->prop( "hash" ),
{ one => 1, two => 2, three => 3 },
'hash property cache' );
my $array_changed = 0;
await $proxy->watch_property_with_initial( "array",
on_updated => sub { $array_changed = 1 },
);
is( $proxy->prop( "array" ),
[ 1, 2, 3 ],
'array property cache' );
$obj->add_number( four => 4 );
$array_changed = 0;
is( $proxy->prop( "scalar" ),
"1234",
"scalar property cache after update" );
is( $proxy->prop( "hash" ),
{ one => 1, two => 2, three => 3, four => 4 },
'hash property cache after update' );
is( $proxy->prop( "array" ),
[ 1, 2, 3, 4 ],
'array property cache after update' );
$scalar_changed = $hash_changed = $array_changed = 0;
$obj->add_number( five => 4 );
ok( !$scalar_changed, 'scalar unchanged' );
ok( !$array_changed, 'array unchanged' );
is( $proxy->prop( "hash" ),
{ one => 1, two => 2, three => 3, four => 4, five => 4 },
'hash property cache after wrong five' );
$scalar_changed = $hash_changed = $array_changed = 0;
$obj->add_number( five => 5 );
is( $proxy->prop( "scalar" ),
"12345",
"scalar property cache after five" );
is( $proxy->prop( "hash" ),
{ one => 1, two => 2, three => 3, four => 4, five => 5 },
'hash property cache after five' );
is( $proxy->prop( "array" ),
[ 1, 2, 3, 4, 5 ],
'array property cache after five' );
$scalar_changed = $hash_changed = $array_changed = 0;
$obj->del_number( 3 );
is( $proxy->prop( "scalar" ),
"1245",
"scalar property cache after delete three" );
is( $proxy->prop( "hash" ),
{ one => 1, two => 2, four => 4, five => 5 },
'hash property cache after delete three' );
is( $proxy->prop( "array" ),
[ 1, 2, 4, 5 ],
'array property cache after delete three' );
# Just test this directly
$obj->set_prop_array( [ 0 .. 9 ] );
$obj->move_prop_array( 3, 2 );
is( $proxy->prop( "array" ),
[ 0, 1, 2, 4, 5, 3, 6, 7, 8, 9 ],
'array property cacahe after move(+2)' );
$obj->move_prop_array( 5, -2 );
is( $proxy->prop( "array" ),
[ 0 .. 9 ],
'array property cacahe after move(-2)' );
if(HAVE_TEST_MEMORY_CYCLE) {
no warnings 'redefine';
local *Tangence::Property::Instance::_forbid_arrayification = sub {};
memory_cycle_ok( $registry, '$registry has no memory cycles' );
memory_cycle_ok( $obj, '$obj has no memory cycles' );
memory_cycle_ok( $proxy, '$proxy has no memory cycles' );
}
done_testing;
|
