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
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
|
#vim: ft=perl
use strict;
use warnings FATAL => 'all';
use Test::More;
use Test::Exception;
use lib 't/lib';
use_ok( 'DBM::Deep' );
throws_ok {
DBM::Deep->new({ _test => 1 });
} qr/lock_exclusive must be implemented in a child class/, 'Must define lock_exclusive in Storage';
{
no strict 'refs';
*{"DBM::Deep::Storage::Test::lock_exclusive"} = sub { 1 };
}
throws_ok {
DBM::Deep->new({ _test => 1 });
} qr/setup must be implemented in a child class/, 'Must define setup in Engine';
{
no strict 'refs';
*{"DBM::Deep::Engine::Test::setup"} = sub { 1 };
}
throws_ok {
DBM::Deep->new({ _test => 1 });
} qr/unlock must be implemented in a child class/, 'Must define unlock in Storage';
{
no strict 'refs';
*{"DBM::Deep::Storage::Test::unlock"} = sub { 1 };
}
throws_ok {
DBM::Deep->new({ _test => 1 });
} qr/flush must be implemented in a child class/, 'Must define flush in Storage';
{
no strict 'refs';
*{"DBM::Deep::Storage::Test::flush"} = sub { 1 };
}
my $db;
lives_ok {
$db = DBM::Deep->new({ _test => 1 });
} "We finally have enough defined to instantiate";
throws_ok {
$db->lock_shared;
} qr/lock_shared must be implemented in a child class/, 'Must define lock_shared in Storage';
{
no strict 'refs';
*{"DBM::Deep::Storage::Test::lock_shared"} = sub { 1 };
}
lives_ok {
$db->lock_shared;
} 'We have lock_shared defined';
# Yes, this is ordered for good reason. Think about it.
my @methods = (
'begin_work' => [
Engine => 'begin_work',
],
'rollback' => [
Engine => 'rollback',
],
'commit' => [
Engine => 'commit',
],
'supports' => [
Engine => 'supports',
],
'store' => [
Storage => 'is_writable',
Engine => 'write_value',
],
'fetch' => [
Engine => 'read_value',
],
'delete' => [
Engine => 'delete_key',
],
'exists' => [
Engine => 'key_exists',
],
# Why is this one's error message bleeding through?
'clear' => [
Engine => 'clear',
],
);
# Add the following:
# in_txn
# If only I could use natatime(). *sighs*
while ( @methods ) {
my ($entry, $requirements) = splice @methods, 0, 2;
while ( @$requirements ) {
my ($class, $child_method) = splice @$requirements, 0, 2;
throws_ok {
$db->$entry( 1 );
} qr/$child_method must be implemented in a child class/,
"'$entry' requires '$child_method' to be defined in the '$class'";
{
no strict 'refs';
*{"DBM::Deep::${class}::Test::${child_method}"} = sub { 1 };
}
}
lives_ok {
$db->$entry( 1 );
} "Finally have enough for '$entry' to work";
}
throws_ok {
$db->_engine->sector_type;
} qr/sector_type must be implemented in a child class/, 'Must define sector_type in Storage';
{
no strict 'refs';
*{"DBM::Deep::Engine::Test::sector_type"} = sub { 'DBM::Deep::Iterator::Test' };
}
lives_ok {
$db->_engine->sector_type;
} 'We have sector_type defined';
throws_ok {
$db->first_key;
} qr/iterator_class must be implemented in a child class/, 'Must define iterator_class in Iterator';
{
no strict 'refs';
*{"DBM::Deep::Engine::Test::iterator_class"} = sub { 'DBM::Deep::Iterator::Test' };
}
throws_ok {
$db->first_key;
} qr/reset must be implemented in a child class/, 'Must define reset in Iterator';
{
no strict 'refs';
*{"DBM::Deep::Iterator::Test::reset"} = sub { 1 };
}
throws_ok {
$db->first_key;
} qr/get_next_key must be implemented in a child class/, 'Must define get_next_key in Iterator';
{
no strict 'refs';
*{"DBM::Deep::Iterator::Test::get_next_key"} = sub { 1 };
}
lives_ok {
$db->first_key;
} 'Finally have enough for first_key to work.';
done_testing;
|
