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($filename))[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($filename))[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($filename))[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         unless $Config{ use64bitall };
  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($filename))[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 }