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