File Coverage

blib/lib/Data/Hive/Test.pm
Criterion Covered Total %
statement 100 103 97.0
branch 3 6 50.0
condition n/a
subroutine 9 9 100.0
pod 2 2 100.0
total 114 120 95.0


line stmt bran cond sub pod time code
1 3     3   1326 use strict;
  3         6  
  3         95  
2 3     3   15 use warnings;
  3         6  
  3         110  
3             package Data::Hive::Test 1.014;
4             # ABSTRACT: a bundle of tests for Data::Hive stores
5              
6 3     3   15 use Data::Hive;
  3         7  
  3         71  
7 3     3   790 use Data::Hive::Store::Hash;
  3         7  
  3         82  
8              
9 3     3   1197 use Test::More 0.96; # subtest without tests
  3         131803  
  3         26  
10              
11             #pod =head1 SYNOPSIS
12             #pod
13             #pod use Test::More;
14             #pod
15             #pod use Data::Hive::Test;
16             #pod use Data::Hive::Store::MyNewStore;
17             #pod
18             #pod Data::Hive::Test->test_new_hive({ store_class => 'MyNewStore' });
19             #pod
20             #pod # rest of your tests for your store
21             #pod
22             #pod done_testing;
23             #pod
24             #pod =head1 DESCRIPTION
25             #pod
26             #pod Data::Hive::Test is a library of tests that should be passable for any
27             #pod conformant L implementation. It provides a method for
28             #pod running a suite of tests -- which may expand or change -- that check the
29             #pod behavior of a hive store by building a hive around it and testing its behavior.
30             #pod
31             #pod =method test_new_hive
32             #pod
33             #pod Data::Hive::Test->test_new_hive( $desc, \%args_to_NEW );
34             #pod
35             #pod This method expects an (optional) description followed by a hashref of
36             #pod arguments to be passed to Data::Hive's C> method. A new
37             #pod hive will be constructed with those arguments and a single subtest will be run,
38             #pod including subtests that should pass against any conformant Data::Hive::Store
39             #pod implementation.
40             #pod
41             #pod If the tests pass, the method will return the hive. If they fail, the method
42             #pod will return false.
43             #pod
44             #pod =method test_existing_hive
45             #pod
46             #pod Data::Hive::Test->test_existing_hive( $desc, $hive );
47             #pod
48             #pod This method behaves just like C, but expects a hive rather than
49             #pod arguments to use to build one.
50             #pod
51             #pod =cut
52              
53             sub test_new_hive {
54 3     3 1 122 my ($self, $desc, $arg) = @_;
55              
56 3 50       13 if (@_ == 2) {
57 0         0 $arg = $desc;
58 0         0 $desc = "hive tests from Data::Hive::Test";
59             }
60              
61 3         19 my $hive = Data::Hive->NEW($arg);
62              
63 3         27 test_existing_hive($desc, $hive);
64             }
65              
66             sub _set_ok {
67 39     39   89 my ($hive, $value) = @_;
68 39         77 local $Test::Builder::Level = $Test::Builder::Level + 1;
69 39         127 is($hive->SET($value), $value, "we return new value from SET");
70             }
71              
72             sub test_existing_hive {
73 3     3 1 9 my ($self, $desc, $hive) = @_;
74              
75 3 50       12 if (@_ == 2) {
76 3         6 $hive = $desc;
77 3         7 $desc = "hive tests from Data::Hive::Test";
78             }
79              
80 3         10 $desc = "Data::Hive::Test: $desc";
81              
82             my $passed = subtest $desc => sub {
83 3     3   3255 isa_ok($hive, 'Data::Hive');
84              
85 3         1479 is_deeply(
86             [ $hive->KEYS ],
87             [ ],
88             "we're starting with an empty hive",
89             );
90              
91             subtest 'value of one' => sub {
92 3         2467 ok(! $hive->one->EXISTS, "before being set, ->one doesn't EXISTS");
93              
94 3         1091 _set_ok($hive->one, 1);
95              
96 3         1188 ok($hive->one->EXISTS, "after being set, ->one EXISTS");
97              
98 3         1044 is($hive->one->GET, 1, "->one->GET is 1");
99 3         1150 is($hive->one->GET(10), 1, "->one->GET(10) is 1");
100              
101 3         1119 is($hive->one->GET(sub { 2 }), 1, "->one->GET(sub{2}) is 1");
  0         0  
102 3         1774 };
103              
104             subtest 'value of zero' => sub {
105 3         2497 ok(! $hive->zero->EXISTS, "before being set, ->zero doesn't EXISTS");
106              
107 3         1147 _set_ok($hive->zero, 0);
108              
109 3         1173 ok($hive->zero->EXISTS, "after being set, ->zero EXISTS");
110              
111 3         1116 is($hive->zero->GET, 0, "->zero->GET is 0");
112 3         1176 is($hive->zero->GET(10), 0, "->zero->GET(10) is 0");
113 3         4327 };
114              
115             subtest 'value of empty string' => sub {
116 3         2394 ok(! $hive->empty->EXISTS, "before being set, ->empty doesn't EXISTS");
117              
118 3         1091 _set_ok($hive->empty, '');
119              
120 3         1125 ok($hive->empty->EXISTS, "after being set, ->empty EXISTS");
121              
122 3         1066 is($hive->empty->GET, '', "->empty->GET is ''");
123 3         1124 is($hive->empty->GET(10), '', "->empty->GET(10) is ''");
124 3         4455 };
125              
126             subtest 'undef, existing value' => sub {
127 3         2383 ok(! $hive->undef->EXISTS, "before being set, ->undef doesn't EXISTS");
128              
129 3         1094 _set_ok($hive->undef, undef);
130              
131 3         1326 ok($hive->undef->EXISTS, "after being set, ->undef EXISTS");
132              
133 3         1060 is($hive->undef->GET, undef, "->undef->GET is undef");
134 3         1363 is($hive->undef->GET(10), 10, "->undef->GET(10) is 10");
135 3         1134 is($hive->undef->GET(sub{2}), 2, "->undef->GET(sub{2}) is 2");
  3         13  
136 3         3715 };
137              
138             subtest 'non-existing value' => sub {
139 3         2332 ok(! $hive->missing->EXISTS, "before being set, ->missing doesn't EXISTS");
140              
141 3         1060 is($hive->missing->GET, undef, "->missing is undef");
142              
143 3         1339 ok(! $hive->missing->EXISTS, "mere GET-ing won't cause ->missing to EXIST");
144              
145 3         1106 is($hive->missing->GET(10), 10, "->missing->GET(10) is 10");
146 3         1183 is($hive->missing->GET(sub{2}), 2, "->missing->GET(sub{2}) is 2");
  3         19  
147 3         3807 };
148              
149             subtest 'nested value' => sub {
150 3         2363 ok(
151             ! $hive->two->EXISTS,
152             "before setting ->two->deep, ->two doesn't EXISTS"
153             );
154              
155 3         1057 ok(
156             ! $hive->two->deep->EXISTS,
157             "before setting ->two->deep, ->two->deep doesn't EXISTS"
158             );
159              
160 3         1073 is(
161             $hive->two->deep->GET,
162             undef,
163             "before being set, ->two->deep is undef"
164             );
165              
166 3         1346 _set_ok($hive->two->deep, '2D');
167              
168 3         1120 ok(
169             ! $hive->two->EXISTS,
170             "after setting ->two->deep, ->two still doesn't EXISTS"
171             );
172              
173 3         1377 ok(
174             $hive->two->deep->EXISTS,
175             "after setting ->two->deep, ->two->deep EXISTS"
176             );
177              
178 3         1093 is(
179             $hive->two->deep->GET,
180             '2D',
181             "after being set, ->two->deep->GET returns '2D'",
182             );
183              
184 3         1162 is(
185             $hive->two->deep->GET(10),
186             '2D',
187             "after being set, ->two->deep->GET(10) returns '2D'",
188             );
189 3         3671 };
190              
191 3         3858 is_deeply(
192             [ sort $hive->KEYS ],
193             [ qw(empty one two undef zero) ],
194             "in the end, we have the right top-level keys",
195             );
196              
197 3         1959 is(
198             $hive->two->deep->fake->whatever->ROOT->two->deep->GET,
199             '2D',
200             "we can get back to the root easily with ROOT",
201             );
202              
203             subtest 'COPY_ONTO' => sub {
204 3         2493 _set_ok( $hive->copy->x->y->z, 1);
205 3         1134 _set_ok( $hive->copy->a->b, 2);
206 3         1136 _set_ok( $hive->copy->a->b->c->d, 3);
207              
208 3         1251 my $target = Data::Hive->NEW({ store => Data::Hive::Store::Hash->new });
209              
210 3         18 $hive->copy->COPY_ONTO($target->clone);
211              
212 3         11 is_deeply(
213             $target->STORE->hash_store,
214             {
215             'clone.x.y.z' => '1',
216             'clone.a.b' => '2',
217             'clone.a.b.c.d' => '3',
218             },
219             "we can copy structures",
220             );
221 3         1101 };
222              
223             subtest 'DELETE' => sub {
224 3         2476 _set_ok($hive->to_delete->top, 10);
225 3         1178 _set_ok($hive->to_delete->top->middle, 20);
226 3         1172 _set_ok($hive->to_delete->top->middle->bottom, 20);
227              
228 3         1142 $hive->to_delete->top->middle->DELETE;
229              
230 3         27 ok(
231             $hive->to_delete->top->EXISTS,
232             "delete middle, top is still there",
233             );
234              
235 3         1075 ok(
236             ! $hive->to_delete->top->middle->EXISTS,
237             "delete middle, so it is gone",
238             );
239              
240 3         1138 ok(
241             $hive->to_delete->top->middle->bottom->EXISTS,
242             "delete middle, bottom is still there",
243             );
244 3         3956 };
245              
246             subtest 'DELETE_ALL' => sub {
247 3         2311 _set_ok($hive->doomed->alpha->branch->value, 1);
248 3         1149 _set_ok($hive->doomed->bravo->branch->value, 1);
249              
250 3         1176 is_deeply(
251             [ sort $hive->doomed->KEYS ],
252             [ qw(alpha bravo) ],
253             "created hive with two subhives",
254             );
255              
256 3         2008 $hive->doomed->alpha->DELETE_ALL;
257              
258 3         19 is_deeply(
259             [ sort $hive->doomed->KEYS ],
260             [ qw(bravo) ],
261             "doing a DELETE_ALL gets rid of all deeper values",
262             );
263              
264 3         1732 is(
265             $hive->doomed->alpha->branch->value->GET,
266             undef,
267             "the deeper value is now undef",
268             );
269              
270 3         1377 ok(
271             ! $hive->doomed->alpha->branch->value->EXISTS,
272             "the deeper value does not exist",
273             );
274              
275 3         1157 is(
276             $hive->doomed->bravo->branch->value->GET,
277             1,
278             "the deep value on another branch is not gone",
279             );
280 3         3964 };
281 3         30 };
282              
283 3 50       8266 return $passed ? $hive : ();
284             }
285              
286             1;
287              
288             __END__