r14213@rob-kinyons-computer (orig r8080): rkinyon | 2006-11-17 20:47:50 -0500
[dbsrgits/DBM-Deep.git] / t / 13_setpack.t
1 ##
2 # DBM::Deep Test
3 ##
4 use strict;
5 use Config;
6 use Test::More tests => 10;
7 use t::common qw( new_fh );
8
9 use_ok( 'DBM::Deep' );
10
11 my ($default, $small, $medium, $large);
12
13 {
14     my ($fh, $filename) = new_fh();
15     my $db = DBM::Deep->new(
16         file => $filename,
17         autoflush => 1,
18     );
19     $db->{key1} = "value1";
20     $db->{key2} = "value2";
21     $default = (stat($db->_fh()))[7];
22 }
23
24 {
25     my ($fh, $filename) = new_fh();
26     {
27         my $db = DBM::Deep->new(
28             file => $filename,
29             autoflush => 1,
30             pack_size => 'medium',
31         );
32
33         $db->{key1} = "value1";
34         $db->{key2} = "value2";
35         $medium = (stat($db->_fh()))[7];
36     }
37
38     # This tests the header to verify that the pack_size is really there
39     {
40         my $db = DBM::Deep->new(
41             file => $filename,
42         );
43
44         is( $db->{key1}, 'value1', 'Can read key1' );
45         is( $db->{key2}, 'value2', 'Can read key2' );
46     }
47
48     cmp_ok( $medium, '==', $default, "The default is medium" );
49 }
50
51 {
52     my ($fh, $filename) = new_fh();
53     {
54         my $db = DBM::Deep->new(
55             file => $filename,
56             autoflush => 1,
57             pack_size => 'small',
58         );
59
60         $db->{key1} = "value1";
61         $db->{key2} = "value2";
62         $small = (stat($db->_fh()))[7];
63     }
64
65     # This tests the header to verify that the pack_size is really there
66     {
67         my $db = DBM::Deep->new(
68             file => $filename,
69         );
70
71         is( $db->{key1}, 'value1', 'Can read key1' );
72         is( $db->{key2}, 'value2', 'Can read key2' );
73     }
74
75     cmp_ok( $medium, '>', $small, "medium is greater than small" );
76 }
77
78 SKIP: {
79     skip "Largefile support is not compiled into $^X", 3
80         if 1; #unless $Config{ uselargefile };
81
82     my ($fh, $filename) = new_fh();
83     {
84         my $db = DBM::Deep->new(
85             file => $filename,
86             autoflush => 1,
87             pack_size => 'large',
88         );
89
90         $db->{key1} = "value1";
91         $db->{key2} = "value2";
92         $large = (stat($db->_fh()))[7];
93     }
94
95     # This tests the header to verify that the pack_size is really there
96     {
97         my $db = DBM::Deep->new(
98             file => $filename,
99         );
100
101         is( $db->{key1}, 'value1', 'Can read key1' );
102         is( $db->{key2}, 'value2', 'Can read key2' );
103     }
104     cmp_ok( $medium, '<', $large, "medium is smaller than large" );
105 }