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     eval "pack('Q', 0);";
  80     skip "Largefile support is not compiled into $^X", 3
  81         if $@;
  82
  83     my ($fh, $filename) = new_fh();
  84     {
  85         my $db = DBM::Deep->new(
  86             file => $filename,
  87             autoflush => 1,
  88             pack_size => 'large',
  89         );
  90
  91         $db->{key1} = "value1";
  92         $db->{key2} = "value2";
  93         $large = (stat($filename))[7];
  94     }
  95
  96     # This tests the header to verify that the pack_size is really there
  97     {
  98         my $db = DBM::Deep->new(
  99             file => $filename,
 100         );
 101
 102         is( $db->{key1}, 'value1', 'Can read key1' );
 103         is( $db->{key2}, 'value2', 'Can read key2' );
 104     }
 105     cmp_ok( $medium, '<', $large, "medium is smaller than large" );
 106 }