File Coverage

blib/lib/Cache/BaseCacheTester.pm
Criterion Covered Total %
statement 20 28 71.4
branch 1 2 50.0
condition 1 3 33.3
subroutine 6 8 75.0
pod 4 4 100.0
total 32 45 71.1


line stmt bran cond sub pod time code
1             ######################################################################
2             # $Id: BaseCacheTester.pm,v 1.7 2002/04/07 17:04:46 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              
12             package Cache::BaseCacheTester;
13              
14              
15 4     4   16 use strict;
  4         5  
  4         1301  
16              
17              
18             sub new
19             {
20 6     6 1 427 my ( $proto, $base_test_count ) = @_;
21 6   33     36 my $class = ref( $proto ) || $proto;
22 6         16 my $self = {};
23 6         12 bless ( $self, $class );
24              
25 6 50       15 $base_test_count = defined $base_test_count ? $base_test_count : 0 ;
26              
27 6         48 $self->_set_test_count( $base_test_count );
28              
29 6         13 return $self;
30             }
31              
32              
33             sub ok
34             {
35 158     158 1 226 my ( $self ) = @_;
36              
37 158         383 my $test_count = $self->_get_test_count( );
38              
39 158         32293 print "ok $test_count\n";
40              
41 158         628 $self->_increment_test_count( );
42             }
43              
44              
45             sub not_ok
46             {
47 0     0 1 0 my ( $self, $message ) = @_;
48              
49 0         0 my $test_count = $self->_get_test_count( );
50              
51 0         0 print "not ok $test_count # failed '$message'\n";
52              
53 0         0 $self->_increment_test_count( );
54             }
55              
56              
57             sub skip
58             {
59 0     0 1 0 my ( $self, $message ) = @_;
60              
61 0         0 my $test_count = $self->_get_test_count( );
62              
63 0         0 print "ok $test_count # skipped $message \n";
64              
65 0         0 $self->_increment_test_count( );
66             }
67              
68              
69             sub _set_test_count
70             {
71 6     6   12 my ( $self, $test_count ) = @_;
72              
73 6         38 $self->{_Test_Count} = $test_count;
74             }
75              
76              
77             sub _get_test_count
78             {
79 160     160   257 my ( $self ) = @_;
80              
81 160         334 return $self->{_Test_Count};
82             }
83              
84              
85             sub _increment_test_count
86             {
87 158     158   241 my ( $self ) = @_;
88              
89 158         817 $self->{_Test_Count}++;
90             }
91              
92              
93             1;
94              
95              
96             __END__