File Coverage

blib/lib/Cache/SizeAwareCacheTester.pm

Criterion	Covered	Total	%
statement	79	79	100.0
branch	16	32	50.0
condition			n/a
subroutine	8	8	100.0
pod	1	1	100.0
total	104	120	86.7

line	stmt	bran	sub	pod	time	code
1						######################################################################
2						# $Id: SizeAwareCacheTester.pm,v 1.12 2003/04/15 14:46:23 dclinton Exp $
3						# Copyright (C) 2001-2003 DeWitt Clinton All Rights Reserved
4						#
5						# Software distributed under the License is distributed on an "AS
6						# IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or
7						# implied. See the License for the specific language governing
8						# rights and limitations under the License.
9						######################################################################
10
11						package Cache::SizeAwareCacheTester;
12
13	2		2		32	use strict;
	2				31
	2				30
14	2		2		31	use Cache::BaseCacheTester;
	2				18
	2				29
15	2		2		56	use Cache::Cache;
	2				17
	2				36
16
17	2		2		29	use vars qw( @ISA );
	2				18
	2				28
18
19						@ISA = qw ( Cache::BaseCacheTester );
20
21
22						sub test
23						{
24	2		2	1	37	my ( $self, $cache ) = @_;
25
26	2				25	$self->_test_one( $cache );
27	2				24	$self->_test_two( $cache );
28	2				31	$self->_test_three( $cache );
29						}
30
31
32						# Test the limit_size( ) method, which should automatically purge the
33						# first object added (with the closer expiration time)
34
35						sub _test_one
36						{
37	2		2		21	my ( $self, $cache ) = @_;
38
39	2	50			23	$cache or
40						croak( "cache required" );
41
42	2				26	$cache->clear( );
43
44	2				28	my $empty_size = $cache->size( );
45
46	2	50			147	( $empty_size == 0 ) ?
47						$self->ok( ) : $self->not_ok( '$empty_size == 0' );
48
49	2				20	my $first_key = 'Key 1';
50
51	2				19	my $first_expires_in = '10';
52
53	2				19	my $value = $self;
54
55	2				28	$cache->set( $first_key, $value, $first_expires_in );
56
57	2				29	my $first_size = $cache->size( );
58
59	2	50			37	( $first_size > $empty_size ) ?
60						$self->ok( ) : $self->not_ok( '$first_size > $empty_size' );
61
62	2				18	my $size_limit = $first_size;
63
64	2				19	my $second_key = 'Key 2';
65
66	2				24	my $second_expires_in = $first_expires_in * 2;
67
68	2				27	$cache->set( $second_key, $value, $second_expires_in );
69
70	2				34	my $second_size = $cache->size( );
71
72	2	50			37	( $second_size > $first_size ) ?
73						$self->ok( ) : $self->not_ok( '$second_size > $first_size' );
74
75	2				27	$cache->limit_size( $size_limit );
76
77	2				41	my $first_value = $cache->get( $first_key );
78
79	2	50			40	( not defined $first_value ) ?
80						$self->ok( ) : $self->not_ok( 'not defined $first_value' );
81
82	2				26	my $third_size = $cache->size( );
83
84	2	50			33	( $third_size <= $size_limit ) ?
85						$self->ok( ) : $self->not_ok( '$third_size <= $size_limit' );
86						}
87
88
89
90						# Test the limit_size method when a number of objects can expire
91						# simultaneously
92
93						sub _test_two
94						{
95	2		2		19	my ( $self, $cache ) = @_;
96
97	2	50			25	$cache or
98						croak( "cache required" );
99
100	2				27	$cache->clear( );
101
102	2				34	my $empty_size = $cache->size( );
103
104	2	50			59	( $empty_size == 0 ) ?
105						$self->ok( ) : $self->not_ok( '$empty_size == 0' );
106
107	2				20	my $value = "A very short string";
108
109	2				20	my $first_key = 'Key 0';
110
111	2				19	my $first_expires_in = 20;
112
113	2				28	$cache->set( $first_key, $value, $first_expires_in );
114
115	2				31	my $first_size = $cache->size( );
116
117	2	50			2430	( $first_size > $empty_size ) ?
118						$self->ok( ) : $self->not_ok( '$first_size > $empty_size' );
119
120	2				21	my $second_expires_in = $first_expires_in / 2;
121
122	2				19	my $num_keys = 5;
123
124						for ( my $i = 1; $i <= $num_keys; $i++ )
125						{
126	10				104	my $key = 'Key ' . $i;
127
128	10				10049399	sleep ( 1 );
129
130	10				241	$cache->set( $key, $value, $second_expires_in );
131	2				19	}
132
133	2				29	my $second_size = $cache->size( );
134
135	2	50			39	( $second_size > $first_size ) ?
136						$self->ok( ) : $self->not_ok( '$second_size > $first_size' );
137
138	2				19	my $size_limit = $first_size;
139
140	2				28	$cache->limit_size( $size_limit );
141
142	2				48	my $third_size = $cache->size( );
143
144	2	50			38	( $third_size <= $size_limit ) ?
145						$self->ok( ) : $self->not_ok( '$third_size <= $size_limit' );
146
147	2				30	my $first_value = $cache->get( $first_key );
148
149	2	50			120	( $first_value eq $value ) ?
150						$self->ok( ) : $self->not_ok( '$first_value eq $value' );
151
152						}
153
154
155						# Test the max_size( ) method, which should keep the cache under
156						# the given size
157
158						sub _test_three
159						{
160	2		2		22	my ( $self, $cache ) = @_;
161
162	2	50			25	$cache or
163						croak( "cache required" );
164
165	2				29	$cache->clear( );
166
167	2				68	my $empty_size = $cache->size( );
168
169	2	50			34	( $empty_size == 0 ) ?
170						$self->ok( ) : $self->not_ok( '$empty_size == 0' );
171
172	2				19	my $first_key = 'Key 1';
173
174	2				19	my $value = $self;
175
176	2				30	$cache->set( $first_key, $value );
177
178	2				31	my $first_size = $cache->size( );
179
180	2	50			39	( $first_size > $empty_size ) ?
181						$self->ok( ) : $self->not_ok( '$first_size > $empty_size' );
182
183	2				17	my $max_size = $first_size;
184
185	2				44	$cache->set_max_size( $max_size );
186
187	2				20	my $second_key = 'Key 2';
188
189	2				27	$cache->set( $second_key, $value );
190
191	2				40	my $second_size = $cache->size( );
192
193	2	50			57	( $second_size <= $max_size ) ?
194						$self->ok( ) : $self->not_ok( '$second_size <= $max_size' );
195						}
196
197
198						1;
199
200
201						__END__
202
203						=pod
204
205						=head1 NAME
206
207						Cache::SizeAwareCacheTester -- a class for regression testing size aware caches
208
209						=head1 DESCRIPTION
210
211						The SizeCacheTester is used to verify that a cache implementation honors
212						its contract with respect to resizing capabilities
213
214						=head1 SYNOPSIS
215
216						use Cache::SizeAwareMemoryCache;
217						use Cache::SizeAwareCacheTester;
218
219						my $cache = new Cache::SizeAwareMemoryCache( );
220
221						my $cache_tester = new Cache::SizeAwareCacheTester( 1 );
222
223						$cache_tester->test( $cache );
224
225						=head1 METHODS
226
227						=over
228
229						=item B<new( $initial_count )>
230
231						Construct a new SizeAwareCacheTester object, with the counter starting
232						at I<$initial_count>.
233
234						=item B<test( )>
235
236						Run the tests.
237
238						=back
239
240						=head1 SEE ALSO
241
242						Cache::Cache, Cache::BaseCacheTester, Cache::CacheTester
243
244						=head1 AUTHOR
245
246						Original author: DeWitt Clinton <dewitt@unto.net>
247
248						Last author: $Author: dclinton $
249
250						Copyright (C) 2001-2003 DeWitt Clinton
251
252						=cut
253