4 use warnings FATAL => 'all';
9 use t::common qw( new_fh );
11 use_ok( 'DBM::Deep' );
13 # test a corrupted file
15 my ($fh, $filename) = new_fh();
17 open FH, ">$filename";
22 DBM::Deep->new( $filename );
23 } qr/DBM::Deep: Pre-1.00 file version found/, "Fail if there's a bad header";
27 my ($fh, $filename) = new_fh();
29 tie %hash, 'DBM::Deep', $filename;
34 tie @array, 'DBM::Deep', $filename;
35 } qr/DBM::Deep: File type mismatch/, "Fail if we try and tie a hash file with an array";
38 DBM::Deep->new( file => $filename, type => DBM::Deep->TYPE_ARRAY )
39 } qr/DBM::Deep: File type mismatch/, "Fail if we try and open a hash file with an array";
43 my ($fh, $filename) = new_fh();
45 tie @array, 'DBM::Deep', $filename;
50 tie %hash, 'DBM::Deep', $filename;
51 } qr/DBM::Deep: File type mismatch/, "Fail if we try and tie an array file with a hash";
54 DBM::Deep->new( file => $filename, type => DBM::Deep->TYPE_HASH )
55 } qr/DBM::Deep: File type mismatch/, "Fail if we try and open an array file with a hash";
62 data_sector_size => 32,
65 while ( my ($attr, $floor) = each %floors ) {
67 my ($fh, $filename) = new_fh();
69 my $db = DBM::Deep->new(
73 } qr{Floor of $attr is $floor\. Setting it to $floor from '\Q(undef)\E'},
74 "Warning for $attr => undef is correct";
77 my ($fh, $filename) = new_fh();
79 my $db = DBM::Deep->new(
83 } qr{Floor of $attr is $floor\. Setting it to $floor from ''},
84 "Warning for $attr => '' is correct";
87 my ($fh, $filename) = new_fh();
89 my $db = DBM::Deep->new(
93 } qr{Floor of $attr is $floor\. Setting it to $floor from 'abcd'},
94 "Warning for $attr => 'abcd' is correct";
97 my ($fh, $filename) = new_fh();
100 my $db = DBM::Deep->new(
104 } qr{Floor of $attr is $floor\. Setting it to $floor from '$val'},
105 "Warning for $attr => $val is correct";
112 data_sector_size => 256,
115 while ( my ($attr, $ceiling) = each %ceilings ) {
116 my ($fh, $filename) = new_fh();
118 my $db = DBM::Deep->new(
122 } qr{Ceiling of $attr is $ceiling\. Setting it to $ceiling from '1000'},
123 "Warning for $attr => 1000 is correct";
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";
135 DBM::Deep->new( 't/etc/db-0-99_04' );
136 } qr/DBM::Deep: Wrong file version found - 1 - expected 3/, "Fail if opening a file version 1";