File Coverage

File:	t/06-d2o-o2d.t
Coverage:	95.7%

line	stmt	sub	time	code
1	1 1 1	1	2910 2 24	use strict;
2	1 1 1	1	3 1 34	use warnings;
3
4	1 1 1	1	376 67852 5	use Test::More q//;
5	1 1 1	1	435 2224 2	use Test::Exception q//;
6	1 1 1	1	450 1 59	use Util::H2O::More qw/h2o o2h d2o o2d/;
7
8				# for included module required for testing
9	1 1 1	1	227 824 84	use FindBin qw/$Bin/;
10	1 1 1	1	212 468 4	use lib qq{$Bin/lib};
11	1 1 1	1	241 2 1991	use Foo;
12
13	1		72382	my $origin_ref = {
14				somewhere => q{over},
15				the => { rainbow => { way => { out => q{there} } } },
16				};
17
18	1		3	my $ref = {
19				somewhere => q{over},
20				the => { rainbow => { way => { out => q{there} } } },
21				};
22
23	1		2	h2o $ref;
24
25	1		121	is_deeply o2h($ref), $origin_ref, q{'o2h' does inverse of h2o};
26	1		1145	is ref o2h($ref), q{HASH}, q{making sure test ref really is just a 'HASH'};
27
28	1		255	my $ref2 = o2h $ref;
29
30	1		4	h2o -recurse, $ref2;
31	1		338	is_deeply o2h($ref2), $origin_ref, q{'o2h' does inverse of 'h2o --recurse'};
32
33	1		952	my $ref3 = o2h $ref2;
34
35				# composing h2o/o2h in one line
36	1		2	is_deeply o2h( h2o $ref3), $origin_ref, q{'o2h' does inverse of 'h2o --recurse'};
37
38	1		968	my $foo = Foo->new( a => 1 );
39	1		2	is ref o2h($foo), q{HASH}, q{'o2h' works on baptised module-based object};
40
41	1		250	my $_foo = {
42				somewhere => q{over},
43				the => { rainbow => { way => { out => q{there} } } },
44				};
45
46	1		4	my $foo2 = o2h( Foo->new(%$_foo) );
47
48	1		7	is_deeply $foo2, $_foo, q{'o2h' does invere of a package built with 'baptise -recurse'};
49
50	1		1026	my $HoA1 = {
51				one => [qw/1 2 3 4 5/],
52				two => [qw/6 7 8 9 0/],
53				};
54
55	1		3	my $HoA2 = {
56				one => [qw/1 2 3 4 5/],
57				two => [qw/6 7 8 9 0/],
58				};
59
60	1		3	h2o $HoA1;
61	1		93	d2o $HoA2;
62
63	1		7	is_deeply o2h $HoA1, o2d $HoA2, q{HASH refs cleaned inline by h2o and d2o are identical};
64
65				# o2h/o2d returns unblessed datastructures, but doesn't
66				# affect the structure by reference, lik h2o/d2o does
67				# - this is for consistency with Util::H2O
68
69	1		867	$HoA1 = o2h $HoA1;
70	1		72	$HoA2 = o2d $HoA2;
71
72	1		52	is_deeply $HoA1, $HoA2, q{HASH refs purified by o2h and o2d are identical};
73
74	1		818	h2o $HoA1;
75	1		91	d2o $HoA2;
76
77	1		3	is_deeply $HoA1, $HoA2, q{h2o object is identical to d2o object};
78
79	1		878	my $HoAoH = {
80				one => [qw/1 2 3 4 5/],
81				two => [qw/6 7 8 9 0/],
82				three => [ { four => 4, five => 5, six => 6 }, { seven => 7, eight => 8, nine => 9 }, ],
83				ten => {
84				eleven => [qw/11 12 13 14 15 16 17 18 19 20/],
85				twentyone => [
86				{
87				twentytwo => 22,
88				},
89				{
90				twentythree => 23,
91				},
92				{
93				twentyfour => 24,
94				twentyfive => 25,
95				twentysix => 26,
96				},
97				],
98				thirteen => 13,
99				},
100				};
101
102	1		3	d2o $HoAoH;
103
104	1		3	is $HoAoH->one->[0], 1, q{ARRAY ref by index found via accessor};
105	1		251	is $HoAoH->ten->twentyone->[0]->twentytwo, 22, q{accessor deeply contained inside of ARRAY found};
106
107				PUSH_POP:
108				{
109	1 1		241 26	my $twentyone = [
110				{
111				twentytwo => 22,
112				},
113				{
114				twentythree => 23,
115				},
116				{
117				twentyfour => 24,
118				twentyfive => 25,
119				twentysix => 26,
120				},
121				];
122
123	1		2	my $i = 0;
124	1		2	foreach my $e ( $HoAoH->ten->twentyone->all ) {
125	3		17	like ref $e, qr/Util::H2O/, q{Found HASH ref as 'Util::H2O' reference, in list};
126	3		684	foreach my $k ( keys %$e ) {
127	5		478	can_ok $e, ($k);
128	5		1335	is $e->$k, $twentyone->[$i]->{$k}, qq{Got expected value for HASH deeply inside of an ARRAY};
129				}
130	3		724	++$i;
131				}
132
133	1		2	$i = 0;
134	1		2	while ( my $e = $HoAoH->ten->twentyone->pop ) {
135	3		12	like ref $e, qr/Util::H2O/, q{(pop) Found HASH ref as 'Util::H2O' reference, in list};
136	3		657	foreach my $k ( keys %$e ) {
137	5		530	can_ok $e, ($k);
138				}
139	3		773	++$i;
140				}
141	1		2	is $HoAoH->ten->twentyone->scalar, 0, q{ARRAY vmethod 'pop' emptied out entire array};
142
143	1		237	for my $i ( 1 .. 5 ) {
144	5		980	$HoAoH->ten->twentyone->push( { foo => $i } ); # note: for the astute observer, this hash is undecorated
145	5		23	is $HoAoH->ten->twentyone->scalar, $i, qq{(item $i) ARRAY vmethod 'push' added something to the array};
146				}
147	1		238	$HoAoH->ten->twentyone->push( { foo => 6 }, { foo => 7 } );
148
149	1		6	is $HoAoH->ten->twentyone->scalar, 7, q{'scalar' ARRAY vmethod works};
150				}
151
152				UNSHIFT_SHIFT:
153				{
154	1 1		241 4	my $twentyone = [ { foo => 1 }, { foo => 2 }, { foo => 3 }, { foo => 4 }, { foo => 5 }, { foo => 6 }, { foo => 7 }, ];
155
156	1		1	my $i = 0;
157	1		3	foreach my $e ( $HoAoH->ten->twentyone->all ) {
158	7		28	like ref $e, qr/Util::H2O/, q{Found HASH ref as 'Util::H2O' reference, in list};
159	7		1534	foreach my $k ( keys %$e ) {
160	7		14	can_ok $e, ($k);
161	7		1869	is $e->$k, $twentyone->[$i]->{$k}, qq{Got expected value for HASH deeply inside of an ARRAY};
162				}
163	7		1659	++$i;
164				}
165
166	1		2	$i = 0;
167	1		3	while ( my $e = $HoAoH->ten->twentyone->shift ) {
168	7		28	like ref $e, qr/Util::H2O/, q{(shift) Found HASH ref as 'Util::H2O' reference, in list};
169	7		1537	foreach my $k ( keys %$e ) {
170	7		13	can_ok $e, ($k);
171				}
172	7		1842	++$i;
173				}
174	1		3	is $HoAoH->ten->twentyone->scalar, 0, q{ARRAY vmethod 'shift' emptied out entire array};
175
176	1		237	for my $i ( 1 .. 5 ) {
177	5		954	$HoAoH->ten->twentyone->unshift( { foo => $i } ); # note: for the astute observer, this hash is undecorated
178	5		23	is $HoAoH->ten->twentyone->scalar, $i, qq{(item $i) ARRAY vmethod 'unshift' added something to the array};
179				}
180
181	1		247	$HoAoH->ten->twentyone->unshift( { foo => 6 }, { foo => 7 } );
182
183	1		6	is $HoAoH->ten->twentyone->scalar, 7, q{'scalar' ARRAY vmethod works};
184				}
185
186				my $mixed1 = [
187				{
188				one => 1,
189				two => 2,
190				},
191				q{string},
192				143,
193	1	1	2	sub { 1 },
194				undef,
195	1		245	];
196
197				my $mixed2 = [
198				{
199				one => 1,
200				two => 2,
201				},
202				q{string},
203				143,
204	1	1	2	sub { 1 },
205				undef,
206	1		4	];
207
208	1		3	d2o $mixed1;
209
210	1		8	is ref $mixed1->[3], ref $mixed2->[3], q{CODE refs have been preserved and are unaffected};
211
212	1		293	my $code1 = splice @$mixed1, 3, 1;
213	1		2	my $code2 = splice @$mixed2, 3, 1;
214
215	1		3	is $code1->(), $code2->(), q{CODE refs work};
216
217	1		241	is_deeply $mixed1, $mixed2, q{Mixed array, including undef and CODE ref treated properly};
218
219				# testing o2d some more
220	1 0 0	0	693 0 0	$foo = [ qw/1 2 3 4 5/, [qw/ 6 7 8 9 /], { foo => 1, code => sub { 1 } }, sub { 2 }, ];
221
222	1		4	d2o $foo;
223
224	1		6	like ref $foo, qr/Util::H2O::More::__a2o/, q{setting up for testing o2d};
225
226	1		232	$foo2 = o2d $foo;
227
228	1		5	like ref $foo, qr/Util::H2O::More::__a2o/, q{making sure o2d doesn't effect REF, consistent with o2h};
229
230	1		224	is ref $foo2, q{ARRAY}, q{making sure o2d worked on an ARRAY blessed by d2o};
231
232				# testing o2d some more - regression test for Util::H2O's upstream bug #20
233	1 0 0	0	247 0 0	$foo = [ qw/-1 2 -3 4 -5/, [qw/ 6 7 8 9 /], { foo => -1, code => sub { 1 } }, sub { 2 }, ];
234
235	1		65	d2o $foo;
236
237	1		5	like ref $foo, qr/Util::H2O::More::__a2o/, q{setting up for testing o2d};
238
239	1		237	$foo2 = o2d $foo;
240
241	1		5	like ref $foo, qr/Util::H2O::More::__a2o/, q{making sure o2d doesn't effect REF, consistent with o2h};
242
243	1		224	is ref $foo2, q{ARRAY}, q{making sure o2d worked on an ARRAY blessed by d2o};
244
245	1 1	1	243 49	dies_ok { $HoAoH->doesntexist } q{call to non-existing setter dies without '-autoundef'};
246
247	1 1	1	231 25	dies_ok { $HoAoH->ten->doesntexist } q{call to non-existing setter dies without '-autoundef'};
248
249	1		241	done_testing;