Commit | Line | Data |
ffed8b01 |
1 | ## |
2 | # DBM::Deep Test |
3 | ## |
467f373b |
4 | $|++; |
ffed8b01 |
5 | use strict; |
811224a0 |
6 | use Test::More tests => 23; |
f2641a61 |
7 | use Test::Exception; |
811224a0 |
8 | use Test::Warn; |
fde3db1a |
9 | use t::common qw( new_fh ); |
ffed8b01 |
10 | |
11 | use_ok( 'DBM::Deep' ); |
12 | |
1e9d4578 |
13 | ## |
1e9d4578 |
14 | # test a corrupted file |
15 | ## |
e0fc6354 |
16 | { |
17 | my ($fh, $filename) = new_fh(); |
18 | |
19 | open FH, ">$filename"; |
20 | print FH 'DPDB'; |
21 | close FH; |
22 | |
23 | throws_ok { |
24 | DBM::Deep->new( $filename ); |
25 | } qr/DBM::Deep: Pre-1.00 file version found/, "Fail if there's a bad header"; |
26 | } |
1e9d4578 |
27 | |
f2641a61 |
28 | { |
fde3db1a |
29 | my ($fh, $filename) = new_fh(); |
f2641a61 |
30 | my %hash; |
2a81bf9e |
31 | tie %hash, 'DBM::Deep', $filename; |
f2641a61 |
32 | undef %hash; |
33 | |
34 | my @array; |
35 | throws_ok { |
2a81bf9e |
36 | tie @array, 'DBM::Deep', $filename; |
f2641a61 |
37 | } qr/DBM::Deep: File type mismatch/, "Fail if we try and tie a hash file with an array"; |
38 | |
39 | throws_ok { |
2a81bf9e |
40 | DBM::Deep->new( file => $filename, type => DBM::Deep->TYPE_ARRAY ) |
f2641a61 |
41 | } qr/DBM::Deep: File type mismatch/, "Fail if we try and open a hash file with an array"; |
42 | } |
43 | |
44 | { |
fde3db1a |
45 | my ($fh, $filename) = new_fh(); |
f2641a61 |
46 | my @array; |
2a81bf9e |
47 | tie @array, 'DBM::Deep', $filename; |
f2641a61 |
48 | undef @array; |
49 | |
50 | my %hash; |
51 | throws_ok { |
2a81bf9e |
52 | tie %hash, 'DBM::Deep', $filename; |
f2641a61 |
53 | } qr/DBM::Deep: File type mismatch/, "Fail if we try and tie an array file with a hash"; |
54 | |
55 | throws_ok { |
2a81bf9e |
56 | DBM::Deep->new( file => $filename, type => DBM::Deep->TYPE_HASH ) |
f2641a61 |
57 | } qr/DBM::Deep: File type mismatch/, "Fail if we try and open an array file with a hash"; |
58 | } |
e0fc6354 |
59 | |
60 | { |
811224a0 |
61 | my %floors = ( |
62 | max_buckets => 16, |
63 | num_txns => 1, |
64 | data_sector_size => 32, |
65 | ); |
66 | |
67 | while ( my ($attr, $floor) = each %floors ) { |
68 | { |
69 | my ($fh, $filename) = new_fh(); |
70 | warning_like { |
71 | my $db = DBM::Deep->new( |
72 | file => $filename, |
73 | $attr => undef, |
74 | ); |
75 | } qr{Floor of $attr is $floor\. Setting it to $floor from '\Q(undef)\E'}, |
76 | "Warning for $attr => undef is correct"; |
77 | } |
78 | { |
79 | my ($fh, $filename) = new_fh(); |
80 | warning_like { |
81 | my $db = DBM::Deep->new( |
82 | file => $filename, |
83 | $attr => '', |
84 | ); |
85 | } qr{Floor of $attr is $floor\. Setting it to $floor from ''}, |
86 | "Warning for $attr => '' is correct"; |
87 | } |
88 | { |
89 | my ($fh, $filename) = new_fh(); |
90 | warning_like { |
91 | my $db = DBM::Deep->new( |
92 | file => $filename, |
93 | $attr => 'abcd', |
94 | ); |
95 | } qr{Floor of $attr is $floor\. Setting it to $floor from 'abcd'}, |
96 | "Warning for $attr => 'abcd' is correct"; |
97 | } |
98 | { |
99 | my ($fh, $filename) = new_fh(); |
100 | my $val = $floor - 1; |
101 | warning_like { |
102 | my $db = DBM::Deep->new( |
103 | file => $filename, |
104 | $attr => $val, |
105 | ); |
106 | } qr{Floor of $attr is $floor\. Setting it to $floor from '$val'}, |
107 | "Warning for $attr => $val is correct"; |
108 | } |
109 | } |
110 | |
111 | my %ceilings = ( |
112 | max_buckets => 256, |
113 | num_txns => 255, |
114 | data_sector_size => 256, |
115 | ); |
116 | |
117 | while ( my ($attr, $ceiling) = each %ceilings ) { |
118 | my ($fh, $filename) = new_fh(); |
119 | warning_like { |
120 | my $db = DBM::Deep->new( |
121 | file => $filename, |
122 | $attr => 1000, |
123 | ); |
124 | } qr{Ceiling of $attr is $ceiling\. Setting it to $ceiling from '1000'}, |
125 | "Warning for $attr => 1000 is correct"; |
126 | } |
127 | } |
128 | |
129 | { |
e0fc6354 |
130 | throws_ok { |
131 | DBM::Deep->new( 't/old_versions/db.0.983' ); |
132 | } qr/DBM::Deep: Pre-1.00 file version found/, "Fail if opening a pre-1.00 file"; |
133 | } |
134 | |
135 | { |
136 | throws_ok { |
137 | DBM::Deep->new( 't/old_versions/db.0.99_04' ); |
138 | } qr/DBM::Deep: Wrong file version found - 1 - expected 2/, "Fail if opening a file version 1"; |
139 | } |