File Coverage

File:t/06-d2o-o2d-autodundef.t
Coverage:95.9%

linestmtbrancondsubpodtimecode
1# basically how Util::H2O::h2o does it
2
1
1
1
1
3001
2
33
use strict;
3
1
1
1
1
4
1
38
use warnings;
4
5
1
1
1
1
332
71423
6
use Test::More q//;
6
1
1
1
1
581
2269
4
use Test::Exception q//;
7
1
1
1
1
476
2
66
use Util::H2O::More qw/h2o o2h d2o o2d/;
8
9# for included module required for testing
10
1
1
1
1
262
847
111
use FindBin qw/$Bin/;
11
1
1
1
1
212
490
5
use lib qq{$Bin/lib};
12
1
1
1
1
321
2
2238
use Foo;
13
14
1
62372
my $origin_ref = {
15    somewhere => q{over},
16    the       => { rainbow => { way => { out => q{there} } } },
17};
18
19
1
4
my $ref = {
20    somewhere => q{over},
21    the       => { rainbow => { way => { out => q{there} } } },
22};
23
24
1
3
h2o $ref;
25
26
1
111
is_deeply o2h($ref), $origin_ref, q{'o2h' does inverse of h2o};
27
1
1073
is ref o2h($ref), q{HASH}, q{making sure test ref really is just a 'HASH'};
28
29
1
219
my $ref2 = o2h $ref;
30
31
1
3
h2o -recurse, $ref2;
32
1
294
is_deeply o2h($ref2), $origin_ref, q{'o2h' does inverse of 'h2o --recurse'};
33
34
1
1164
my $ref3 = o2h $ref2;
35
36# composing h2o/o2h in one line
37
1
3
is_deeply o2h( h2o $ref3), $origin_ref, q{'o2h' does inverse of 'h2o --recurse'};
38
39
1
807
my $foo = Foo->new( a => 1 );
40
1
3
is ref o2h($foo), q{HASH}, q{'o2h' works on baptised module-based object};
41
42
1
218
my $_foo = {
43    somewhere => q{over},
44    the       => { rainbow => { way => { out => q{there} } } },
45};
46
47
1
3
my $foo2 = o2h( Foo->new(%$_foo) );
48
49
1
7
is_deeply $foo2, $_foo, q{'o2h' does invere of a package built with 'baptise -recurse'};
50
51
1
862
my $HoA1 = {
52    one => [qw/1 2 3 4 5/],
53    two => [qw/6 7 8 9 0/],
54};
55
56
1
4
my $HoA2 = {
57    one => [qw/1 2 3 4 5/],
58    two => [qw/6 7 8 9 0/],
59};
60
61
1
2
h2o $HoA1;
62
1
90
d2o $HoA2;
63
64
1
2
is_deeply o2h $HoA1, o2d $HoA2, q{HASH refs cleaned inline by h2o and d2o are identical};
65
66# o2h/o2d returns unblessed datastructures, but doesn't
67# affect the structure by reference, lik h2o/d2o does
68# - this is for consistency with Util::H2O
69
70
1
704
$HoA1 = o2h $HoA1;
71
1
67
$HoA2 = o2d $HoA2;
72
73
1
45
is_deeply $HoA1, $HoA2, q{HASH refs purified by o2h and o2d are identical};
74
75
1
687
h2o $HoA1;
76
1
80
d2o -autoundef, $HoA2;
77
78
1
3
is_deeply $HoA1, $HoA2, q{h2o object is identical to d2o object};
79
80
1
769
my $HoAoH = {
81    one   => [qw/1 2 3 4 5/],
82    two   => [qw/6 7 8 9 0/],
83    three => [ { four => 4, five => 5, six => 6 }, { seven => 7, eight => 8, nine => 9 }, ],
84    ten   => {
85        eleven    => [qw/11 12 13 14 15 16 17 18 19 20/],
86        twentyone => [
87            {
88                twentytwo => 22,
89            },
90            {
91                twentythree => 23,
92            },
93            {
94                twentyfour => 24,
95                twentyfive => 25,
96                twentysix  => 26,
97            },
98        ],
99        thirteen => 13,
100    },
101};
102
103
1
3
d2o -autoundef, $HoAoH;
104
105
1
3
is $HoAoH->one->[0],                       1,  q{ARRAY ref by index found via accessor};
106
1
218
is $HoAoH->ten->twentyone->[0]->twentytwo, 22, q{accessor deeply contained inside of ARRAY found};
107
108PUSH_POP:
109{
110
1
1
224
5
    my $twentyone = [
111        {
112            twentytwo => 22,
113        },
114        {
115            twentythree => 23,
116        },
117        {
118            twentyfour => 24,
119            twentyfive => 25,
120            twentysix  => 26,
121        },
122    ];
123
124
1
1
    my $i = 0;
125
1
3
    foreach my $e ( $HoAoH->ten->twentyone->all ) {
126
3
11
        like ref $e, qr/Util::H2O/, q{Found HASH ref as 'Util::H2O' reference, in list};
127
3
603
        foreach my $k ( keys %$e ) {
128
5
452
            can_ok $e, ($k);
129
5
1192
            is $e->$k, $twentyone->[$i]->{$k}, qq{Got expected value for HASH deeply inside of an ARRAY};
130        }
131
3
609
        ++$i;
132    }
133
134
1
1
    $i = 0;
135
1
4
    while ( my $e = $HoAoH->ten->twentyone->pop ) {
136
3
11
        like ref $e, qr/Util::H2O/, q{(pop) Found HASH ref as 'Util::H2O' reference, in list};
137
3
562
        foreach my $k ( keys %$e ) {
138
5
444
            can_ok $e, ($k);
139        }
140
3
658
        ++$i;
141    }
142
1
4
    is $HoAoH->ten->twentyone->scalar, 0, q{ARRAY vmethod 'pop' emptied out entire array};
143
144
1
203
    for my $i ( 1 .. 5 ) {
145
5
849
        $HoAoH->ten->twentyone->push( { foo => $i } );    # note: for the astute observer, this hash is undecorated
146
5
19
        is $HoAoH->ten->twentyone->scalar, $i, qq{(item $i) ARRAY vmethod 'push' added something to the array};
147    }
148
1
203
    $HoAoH->ten->twentyone->push( { foo => 6 }, { foo => 7 } );
149
150
1
5
    is $HoAoH->ten->twentyone->scalar, 7, q{'scalar' ARRAY vmethod works};
151}
152
153UNSHIFT_SHIFT:
154{
155
1
1
206
6
    my $twentyone = [ { foo => 1 }, { foo => 2 }, { foo => 3 }, { foo => 4 }, { foo => 5 }, { foo => 6 }, { foo => 7 }, ];
156
157
1
2
    my $i = 0;
158
1
2
    foreach my $e ( $HoAoH->ten->twentyone->all ) {
159
7
23
        like ref $e, qr/Util::H2O/, q{Found HASH ref as 'Util::H2O' reference, in list};
160
7
1311
        foreach my $k ( keys %$e ) {
161
7
13
            can_ok $e, ($k);
162
7
1655
            is $e->$k, $twentyone->[$i]->{$k}, qq{Got expected value for HASH deeply inside of an ARRAY};
163        }
164
7
1407
        ++$i;
165    }
166
167
1
3
    $i = 0;
168
1
4
    while ( my $e = $HoAoH->ten->twentyone->shift ) {
169
7
25
        like ref $e, qr/Util::H2O/, q{(shift) Found HASH ref as 'Util::H2O' reference, in list};
170
7
1341
        foreach my $k ( keys %$e ) {
171
7
17
            can_ok $e, ($k);
172        }
173
7
1587
        ++$i;
174    }
175
1
3
    is $HoAoH->ten->twentyone->scalar, 0, q{ARRAY vmethod 'shift' emptied out entire array};
176
177
1
203
    for my $i ( 1 .. 5 ) {
178
5
812
        $HoAoH->ten->twentyone->unshift( { foo => $i } );    # note: for the astute observer, this hash is undecorated
179
5
20
        is $HoAoH->ten->twentyone->scalar, $i, qq{(item $i) ARRAY vmethod 'unshift' added something to the array};
180    }
181
182
1
225
    $HoAoH->ten->twentyone->unshift( { foo => 6 }, { foo => 7 } );
183
184
1
5
    is $HoAoH->ten->twentyone->scalar, 7, q{'scalar' ARRAY vmethod works};
185}
186
187my $mixed1 = [
188    {
189        one => 1,
190        two => 2,
191    },
192    q{string},
193    143,
194
1
1
2
    sub { 1 },
195    undef,
196
1
210
];
197
198my $mixed2 = [
199    {
200        one => 1,
201        two => 2,
202    },
203    q{string},
204    143,
205
1
1
3
    sub { 1 },
206    undef,
207
1
5
];
208
209
1
4
d2o -autoundef, $mixed1;
210
211
1
5
is ref $mixed1->[3], ref $mixed2->[3], q{CODE refs have been preserved and are unaffected};
212
213
1
204
my $code1 = splice @$mixed1, 3, 1;
214
1
2
my $code2 = splice @$mixed2, 3, 1;
215
216
1
2
is $code1->(), $code2->(), q{CODE refs work};
217
218
1
203
is_deeply $mixed1, $mixed2, q{Mixed array, including undef and CODE ref treated properly};
219
220# testing o2d some more
221
1
0
0
0
640
0
0
$foo = [ qw/1 2 3 4 5/, [qw/ 6 7 8 9 /], { foo => 1, code => sub { 1 } }, sub { 2 }, ];
222
223
1
4
d2o -autoundef, $foo;
224
225
1
6
like ref $foo, qr/Util::H2O::More::__a2o/, q{setting up for testing o2d};
226
227
1
216
$foo2 = o2d $foo;
228
229
1
5
like ref $foo, qr/Util::H2O::More::__a2o/, q{making sure o2d doesn't effect REF, consistent with o2h};
230
231
1
208
is ref $foo2, q{ARRAY}, q{making sure o2d worked on an ARRAY blessed by d2o};
232
233# testing o2d some more - regression test for Util::H2O's upstream bug #20
234
1
0
0
0
211
0
0
$foo = [ qw/-1 2 -3 4 -5/, [qw/ 6 7 8 9 /], { foo => -1, code => sub { 1 } }, sub { 2 }, ];
235
236
1
68
d2o -autoundef, $foo;
237
238
1
5
like ref $foo, qr/Util::H2O::More::__a2o/, q{setting up for testing o2d};
239
240
1
191
$foo2 = o2d $foo;
241
242
1
4
like ref $foo, qr/Util::H2O::More::__a2o/, q{making sure o2d doesn't effect REF, consistent with o2h};
243
244
1
191
is ref $foo2, q{ARRAY}, q{making sure o2d worked on an ARRAY blessed by d2o};
245
246
1
209
is $HoAoH->doesntexist, undef, q{call to non-existing setter returns undef, perl '-autoundef'};
247
248
1
322
is $HoAoH->ten->doesntexist, undef, q{call to non-existing setter returns undef, perl '-autoundef'};
249
250# The ARRAY virtual get()/i() methods return an in-range element and do not
251# grow the ARRAY. count() is the documented alias for scalar().
252
1
273
is $HoAoH->ten->twentyone->get(0)->foo, 6, q{'get' ARRAY vmethod returns an in-range item};
253
1
202
is $HoAoH->ten->twentyone->i(0)->foo,   6, q{'i' ARRAY vmethod aliases 'get'};
254
1
205
is $HoAoH->ten->twentyone->count,       7, q{'count' ARRAY vmethod aliases 'scalar'};
255
256# "-autoundef" permits missing getters, but a missing setter is deliberately
257# rejected so typos cannot silently add new keys.
258
1
1
1
206
34
dies_ok { $HoAoH->doesntexist(q{value}) } q{d2o '-autoundef' refuses to set a non-existing top-level key};
259
1
1
1
198
21
dies_ok { $HoAoH->ten->doesntexist(q{value}) } q{d2o '-autoundef' refuses to set a non-existing nested key};
260
261# d2o with no data is a harmless no-op and returns undef.
262
1
190
is d2o(), undef, q{d2o with no arguments returns undef};
263
264
1
253
done_testing;